Extracting Outlook "Internet Header" information in to Excel 1

[tourcd]

Hi,

I need to extract information contained within the message header (or "Internet Header") in Outlook 2010.

I'd like to pull out the To:, Subject: and Date: information from each email in my inbox and put it in to Excel. The following post
thread707-1253839 has almost got me there.

Unfortunately the To: information extracted by the code in the post isn't the same as the To: info in the message header.

Does anyone know why and whether I can extract it using a similar/modified script?

Many thanks

 

[SkipVought]

hi,

Unfortunately the To: information extracted by the code in the post isn't the same as the To: info in the message header.

What does this mean?

How are they different?

Consider using this technique to discover what you need, faq707-4594

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[tourcd]

The To: information extracted by the code in the linked thread above does not always return a full email address, sometimes it only contains a name.

For example I'd expect to see "email@domain.com" in the To: column and I get "Jo Blogs" instead.

However if you open up the full message header of this message it clearly shows "To: email@domain.com".

 

[SkipVought]

When I use the technique referenced in the FAQ I posted, using this code, I see full email addresses for EXTERNAL mail items and Name aliases, for INTERNAL (Exchange) mail items, examining the MyMail object in the Watch Window...

    Set golApp = New Outlook.Application
    
    Set itm = gnspNameSpace.GetDefaultFolder(olFolderInbox)
    Set itm = itm.Folders(strFolder)
    
    int_cnt = 1
    For Each MyMail In itm.Items

    next

Full code available if required.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[tourcd]

Thanks SkipVought, could you post/send the full code?

 

[SkipVought]

Option Explicit

' Declare global Outlook Application and NameSpace variables.
' These are declared as global variables so that they need not
' be re-created for each procedure that uses them.
Public golApp          As Outlook.Application
Public gnspNameSpace   As Outlook.Namespace

Function InitializeOutlook() As Boolean
   ' This function is used to initialize the global Application and
   ' NameSpace variables.
   
   On Error GoTo Init_Err
   
   Set golApp = New Outlook.Application    ' Application object.
   Set gnspNameSpace = golApp.GetNamespace("MAPI") ' Namespace object.
   
   InitializeOutlook = True

Init_End:
   Exit Function
Init_Err:
   InitializeOutlook = False
   Resume Init_End
End Function

Function CreateMail(astrRecip As Variant, _
                   strSubject As String, _
                   strMessage As String, _
                   Optional astrAttachments As Variant) As Boolean
   ' This procedure illustrates how to create a new mail message
   ' and use the information passed as arguments to set message
   ' properties for the subject, text (Body property), attachments,
   ' and recipients.

   Dim objNewMail            As Outlook.MailItem
   Dim varRecip              As Variant
   Dim varAttach             As Variant
   Dim blnResolveSuccess     As Boolean
   
   On Error GoTo CreateMail_Err
   
   ' Use the InitializeOutlook procedure to initialize global
   ' Application and NameSpace object variables, if necessary.
   If golApp Is Nothing Then
      If InitializeOutlook = False Then
         MsgBox "Unable to initialize Outlook Application " _
            & "or NameSpace object variables!"
         Exit Function
      End If
   End If

   Set golApp = New Outlook.Application
   Set objNewMail = golApp.createitem(olmailitem)
   With objNewMail
      For Each varRecip In astrRecip
         .Recipients.Add varRecip
      Next varRecip
      blnResolveSuccess = .Recipients.ResolveAll
      If Not IsMissing(astrAttachments) Then
        For Each varAttach In astrAttachments
           .Attachments.Add varAttach
        Next varAttach
      End If
      .Subject = strSubject
      .Body = strMessage
      If blnResolveSuccess Then
         .sEnd
      Else
         MsgBox "Unable to resolve all recipients. Please check " _
            & "the names."
         .display
      End If
   End With
   
   CreateMail = True

CreateMail_End:
   Exit Function
CreateMail_Err:
   CreateMail = False
   Resume CreateMail_End
End Function

Sub test()
    funGetEmailData "_EBOM"  '[b][highlight]assign your folder name here[/highlight][/b]
End Sub

Function funGetEmailData(strFolder As String)
'strfolder is the name of the folder you want to look in
'dont forget to refernce oulook libaray if using in another 'app.
 
    Dim fld As Outlook.MAPIFolder
    Dim itm As Object
    Dim MyMail As Outlook.MailItem
    Dim int_cnt As Integer, a, idx As Integer, b
    '-----------
    
    On Error Resume Next

    ' Use the InitializeOutlook procedure to initialize global
    ' Application and NameSpace object variables, if necessary.
    If golApp Is Nothing Then
       If InitializeOutlook = False Then
          MsgBox "Unable to initialize Outlook Application " _
             & "or NameSpace object variables!"
          Exit Function
       End If
    End If
    
    Set golApp = New Outlook.Application
    
    Set itm = gnspNameSpace.GetDefaultFolder(olFolderInbox)
    Set itm = itm.Folders(strFolder)
    
    int_cnt = 1
    For Each MyMail In itm.Items
        a = Split(MyMail.Body, " ")
        For idx = 0 To UBound(a)
            If UBound(Split(a(idx), "-")) > 1 Then
                With ActiveWorkbook.Sheet1
                    .Cells(.[A1].CurrentRegion.Rows.Count + 1, "A").Value = a(idx)
                    Exit For
                End With
            End If
        Next
'        MyMail.Attachments.Item(1).SaveAsFile "H:\Temp " & int_cnt & " "
        
        int_cnt = int_cnt + 1
    
    Next
    
'    For Each MyMail In itm.Items
'        MyMail.Delete
'    Next
    
    Set fld = Nothing
    Set itm = Nothing
    Set MyMail = Nothing

End Function

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}