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
Bookmarks