Count Outlook VBA attachment - vba

Question

Can you help me to improve the below VBA code to be able to correctly count e-mails + attachments form a selected range (outlook 2010)
Sub CountAttachmentsMulti()
Set mySelect = Outlook.ActiveExplorer.Selection
For Each Item In mySelect
j = Item.Attachments.Count + j
i = i + 1
Next Item
MsgBox "Selected " & i & " messages with " & j & " attachements"
End Sub
That is the code the problem is that counts also as attachments the picture in the signatures and give a wrong count meaning more attachments then the actually are
Can you help to amend the code to bypass from counting the images in signatures
BR
Gabi

Answer 1

Try this
Sub CountAttachmentsValid()
Dim olkItem As Outlook.mailitem
Dim olkAttachment As Outlook.attachment
Dim strFilename As String
Dim strExtension As String
Dim lngExtIndex As Long
Dim strBaseFilename As String
Dim cnt As Long
Dim mySelect As Selection
Dim iExt As Long
Dim validExtString As String
Dim validExtArray() As String
validExtString = ".doc .docx .xls .xlsx .msg .pdf .txt" ' <---- Update as needed
validExtArray = Split(validExtString, " ")
Set mySelect = Outlook.ActiveExplorer.Selection
For Each olkItem In mySelect
For Each olkAttachment In olkItem.Attachments
On Error GoTo cannotPerformOperation
strFilename = olkAttachment.FileName
lngExtIndex = InStrRev(strFilename, ".")
strBaseFilename = Left(strFilename, lngExtIndex - 1)
strExtension = Mid(strFilename, lngExtIndex)
For iExt = 0 To UBound(validExtArray)
If LCase(strExtension) = LCase(validExtArray(iExt)) Then
cnt = cnt + 1
Exit For
End If
Next iExt
skipped:
Next olkAttachment
Next olkItem
GoTo exiting
cannotPerformOperation:
'Debug.Print " ** " & olkAttachment.DisplayName & " not counted"
Resume skipped
exiting:
MsgBox "Selected " & mySelect.count & " messages with " & cnt & " recognized attachments"
End Sub