Consulting

Results 1 to 2 of 2

Thread: Outlook VBA check for an attachment

  1. #1
    VBAX Regular
    Joined
    Nov 2009
    Posts
    7
    Location

    Outlook VBA check for an attachment

    Hi

    I am trying to create a macro in Outlook which extracts information from an email and pastes them into an excel 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:\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.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

  2. #2
    VBAX Expert JP2112's Avatar
    Joined
    Oct 2008
    Location
    Astoria, NY
    Posts
    590
    Location
    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.
    Regards,
    JP

    Read the FAQ
    Getting free help on the web
    My website
    Please use [vba][/vba] tags when posting code

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •