Outlook 2010 macro to extract data from email

**jeskit** · 06-13-2011, 04:17 AM

Hi

I have written this macro in Microsoft Outlook 2010 which opens an excel workbook and then from the open email extracts data from the email and inserts it into the excel workbook.

Option Explicit
Sub EmailExtracter()

Dim strFldr As String
Dim OEM, Nrow As String
Dim SuggestOEM As Integer
Dim OutMail As Object
Dim xlApp, xlbook, xlbookSht As Object

Set OutMail = ActiveInspector.CurrentItem

strFldr = "C:\Documents and Settings\SeymourJ\Desktop\Tasks"

Set xlApp = CreateObject("Excel.Application")
    xlApp.Application.Visible = True
    xlApp.Workbooks.Open strFldr & "\EmailTest.xls"
Set xlbook = xlApp.Workbooks.Open(strFldr & "\EmailTest.xls")
Set xlbookSht = xlbook.sheets("EmailData")

Nrow = xlApp.WorksheetFunction.CountA(xlbookSht.Range("A:A"))
OEM = xlApp.Application.InputBox("Please enter the OEM name of the email", "OEM Entry Box", SuggestOEM)

If OEM = "" Or OEM = 0 Then
    MsgBox "Please enter a name or enter Not Applicable, Thank you"
    OEM = xlApp.Application.InputBox("Please enter the OEM name of the email", "OEM Entry Box", SuggestOEM)
End If

Nrow = xlApp.WorksheetFunction.CountA(xlbook.sheets("EmailData").Range("A:A"))

xlbookSht.Range("A" & Nrow + 1).Value = OEM

xlbookSht.Range("B" & Nrow + 1).Value = OutMail.SenderEmailAddress

xlbookSht.Range("C" & Nrow + 1).Value = OutMail.To

xlbookSht.Range("D" & Nrow + 1).Value = OutMail.CC

xlbookSht.Range("E" & Nrow + 1).Value = OutMail.SentOn

xlbookSht.Range("F" & Nrow + 1).Value = OutMail.ReceivedTime

xlbookSht.Range("G" & Nrow + 1).Value = OutMail.Subject

xlbookSht.Columns("A:H").EntireColumn.AutoFit

xlbookSht.SaveAs strFldr & "\" & "EmailTest.xls"

End Sub

However does anyone know how to add a line which says if there is an attachment place the name of the file into column H else put False into column H?

Thanks

Jeskit

**Domski** · 06-13-2011, 05:39 AM

You can check for attachments like this I think:

If OutMail.Attachments.Count > 0 Then
' Do whatever you want
End If

Would need more info as to how you would deal with multiple attachments to be more specific.

Dom

**jeskit** · 06-13-2011, 06:01 AM

Hi

Thanks for that, that works!

Would you know that the item class is for attaching the name of the attachment?? I ahve tried .Attachments, .AttachmentsAdd but they didn't work.

Thanks

**Domski** · 06-13-2011, 06:27 AM

Something like this:

Dim itm As Object
Dim OutMail As MailItem

Set itm = ActiveInspector.CurrentItem

If itm.Class = olMail Then
    Set OutMail = itm
    If OutMail.Attachments.Count > 0 Then
        MsgBox OutMail.Attachments(1).Filename
    End If
End If

Dom

**anchuri_chaitanya** · 06-27-2011, 05:37 AM

Hi,.

Can anyone help me in getting out of this..

In outlook emails, if in the body of a mail contains like any tables.. how to get that table of contents from the body of a mail to excel cell by cell using macro programming..

Please help me with the code.....

urgently needed.....

Thanks & Regards
Chaitanya Balaji