Outlook VBA check for an attachment

[jess]

Hi

I am trying to create a macro in Outlook which extracts information from an email and pastes them into an excel (http://www.vbforums.com/showthread.php?t=654827#) word document.

So far the macro i have extracts the sender email address, who it was to, if anyone was copied in, date it was sent on, data it was received and the subject.

However i need to also check the email for any attachments and then if there is an attachment paste the attachment filename into the column H else enter No Attachment into column H.

[code]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 (http://www.vbforums.com/showthread.php?t=654827#):\Documents and Settings\SeymourJ\Desktop\Tasks"

Set xlApp = CreateObject("Excel.Application (http://www.vbforums.com/showthread.php?t=654827#)")
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.Range("H" & Nrow + 1).Value =

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

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

End Sub [/end code]

Does anyone know how to check for a attachment?

Thanks

Jeskit

[JP2112]

Check OutMail.Attachments.Count to see if there are attachments. Loop through the collection and save each one to disk using OutMail.Attachments(loop counter).SaveAsFile "your filename" then you can put "your filename" in column H of your worksheet.