Get attachments file names from emails vba

Question

I have a folder that has emails with attachments and without attachments. i have the code for extracting the attachments names but if an email doesn't have attachments the code will stop. Any help is welcomed, thank you.

by jimmypena

Private Sub CommandButton2_Click()

Dim a As Attachments
Dim myitem As Folder
Dim myitem1 As MailItem
Dim j As Long
Dim i As Integer

Set myitem = Session.GetDefaultFolder(olFolderDrafts)

For i = 1 To myitem.Items.Count
  If myitem.Items(i) = test1 Then
    Set myitem1 = myitem.Items(i)
    Set a = myitem1.Attachments

    MsgBox a.Count

    ' added this code
    For j = 1 To myitem1.Attachments.Count
      MsgBox myitem1.Attachments.Item(i).DisplayName ' or .Filename
    Next j

  End If
Next i
End Sub

My code:

Sub EXPORT()

    Const FOLDER_PATH = "\\Mailbox\Inbox\emails from them"
    Dim olkMsg As Object, _
        olkFld As Object, _
        excApp As Object, _
        excWkb As Object, _
        excWks As Object, _
        intRow As Integer, _
        intCnt As Integer, _
        strFileName As String, _
        arrCells As Variant
        strFileName = "C:\EXPORT"
        If strFileName <> "" Then
        Set excApp = CreateObject("Excel.Application")
        Set excWkb = excApp.Workbooks.Add()
        Set excWks = excWkb.ActiveSheet
        excApp.DisplayAlerts = False
        With excWks

            .Cells(1, 1) = "ATTACH NAMES"
            .Cells(1, 2) = "SENDER"
            .Cells(1, 3) = "NR SUBJECT"
            .Cells(1, 4) = "CATEGORIES"

        End With
        intRow = 2
        Set olkFld = OpenOutlookFolder(FOLDER_PATH)
        For Each olkMsg In olkFld.Items
            If olkMsg.Class = olMail Then
                arrCells = Split(GetCells(olkMsg.HTMLBody), Chr(255))


                    Dim Reg1 As RegExp
                    Dim M1 As MatchCollection
                    Dim M As match
                    Set Reg1 = New RegExp
                        With Reg1
                        .Pattern = "\s*[-]+\s*(\w*)\s*(\w*)"
                        .Global = True
                        End With
                           Set M1 = Reg1.Execute(olkMsg.Subject)
                           For Each M In M1
                excWks.Cells(intRow, 3) = M
                           Next

                Dim a As Attachments
                Set a = olkMsg.Attachments
                If Not a Is Nothing Then


                excWks.Cells(intRow, 1) = olkMsg.Attachment.Filename
                'excWks.Cells(intRow, 2) = olkMsg.SenderEmailAddress
                End If

                excWks.Cells(intRow, 2) = olkMsg.sender.GetExchangeUser.PrimarySmtpAddress
                excWks.Cells(intRow, 4) = olkMsg.Categories

                intRow = intRow + 1
                intCnt = intCnt + 1
            End If
        Next
        Set olkMsg = Nothing
        excWkb.SaveAs strFileName, 52
        excWkb.Close
    End If
    Set olkFld = Nothing
    Set excWks = Nothing
    Set excWkb = Nothing
    Set excApp = Nothing
    MsgBox "Ta dam! "
End Sub

Answer 1

edited

Set a = myitem1.Attachments
MsgBox a.Count

For j = 1 To myitem1.Attachments.Count
   MsgBox myitem1.Attachments.Item(j).DisplayName ' or .Filename
Next j

as about your edited question, replace the following snippet

            Dim a As Attachments
            Set a = olkMsg.Attachments
            If Not a Is Nothing Then


            excWks.Cells(intRow, 1) = olkMsg.Attachment.Filename
            'excWks.Cells(intRow, 2) = olkMsg.SenderEmailAddress
            End If

with:

        Dim a As Attachment
        For Each a In olkMsg.Attachments
            excWks.Cells(intRow, 1) = a.FileName
            'excWks.Cells(intRow, 2) = a.SenderEmailAddress
        Next a

which you must treat appropriately as for the intRow index.

if you are interested in only the first attachment then you could substitute the entire last code with this:

excWks.Cells(intRow, 1) = olkMsg.Attachments.Item(1).FileName

while if you are interested in all attachments then you'll have to rethink about your sheet report structure