Counting attached files in outlook

[PacVII]

The other day I posted a question on counting attached files to emails in outlook. Had a great answer and the following VBA. So the new problem is it works to good. Its counting everything in the email as an attached file. I been looking to see if others may have had a solution to filter out items that are really not an attachment but have not had any luck. I am again asking here and hope someone can help. I really only need to be counting the attached files as in a DOC, PDF, XLS etc and not all the other items that maybe in the mail such as the signature jpg etc... any help would be great. Thanks in advance.

Sub CountEmails()
Dim objOutlook As Object, objnSpace As Object, objFolder As Object
Dim EmailCount As Integer
Dim AttCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")

On Error Resume Next
Set objFolder = objnSpace.Folders("Personal Mail").Folders("inbox")
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Exit Sub
End If

EmailCount = objFolder.items.Count
For Each Item In objFolder.items
x = Item.Attachments.Count
AttCount = AttCount + x
Next

MsgBox "Number of emails in the folder: " & EmailCount
MsgBox AttCount & " attachments"
Range("B3").Select
Selection = EmailCount
Range("B4").Select
Selection = AttCount

End Sub

 

[Worf]

Like this:

' Excel module
Sub CountEmails()
Dim objOutlook As Object, nSpace As Namespace, fld As folder, _
att As Attachment, AttCount%, item As MailItem
Set objOutlook = CreateObject("Outlook.Application")
Set nSpace = objOutlook.GetNamespace("MAPI")
On Error Resume Next
Set fld = nSpace.GetDefaultFolder(olFolderInbox)    ' desired folder
If Err.Number <> 0 Then
    Err.Clear
    MsgBox "No such folder."
    Exit Sub
End If
AttCount = 0
For Each item In fld.Items
    If item.Attachments.Count > 0 Then
        For Each att In item.Attachments
            Select Case LCase$(Right$(att.Filename, 4))
                 Case ".pdf", "docx", ".doc", ".xls", "xlsx", "docm", "xlsm"
                    AttCount = AttCount + 1
            End Select
        Next
    End If
Next
MsgBox "Emails in the folder: " & fld.Items.Count & vbLf & "Attachments: " & AttCount
[B3] = fld.Items.Count
[B4] = AttCount
End Sub

 

[PacVII]

I am getting an Compile Error: User-defined type not defined. in the nSpace As Namespace. in line Dim objOutlook As Object, nSpace As Namespace, fld As folder, _

I had some other feed back that has me real close. Thank you so very much for the follow up. Just to share:
Sub CounttestingEmails()
Dim objOutlook As Object, objnSpace As Object, objFolder As Object
Dim EmailCount As Integer
Dim AttCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
On Error Resume Next
Set objFolder = objnSpace.Folders("Personal Mail").Folders("inbox")
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Exit Sub
End If

'File extensions you want to find
FileNmeArr = Array("doc", "pdf", "doc", "xlsx", "docx")

EmailCount = objFolder.items.Count

For Each item In objFolder.items
x = item.Attachments.Count
TotalAttCount = TotalAttCount + x

'If there are attachments find the filename then get the extension
If x > 0 Then
FlNme = item.Attachments.item(x).FileName
FileExtn = Right(FlNme, Len(FlNme) - InStrRev(FlNme, "."))

'Compare the filename extension to the array indexes. Use arrAttach for the wanted count
For arrIndex = LBound(FileNmeArr) To UBound(FileNmeArr)
If (StrComp(FileExtn, FileNmeArr(arrIndex), vbTextCompare) = 0) Then
arrAttch = arrAttch + 1
FileMatched = True
End If

'If there's an extension match add it to the count
Next
If FileMatched = True Then
AttCount = arrAttch
End If
End If
Next

MsgBox ("Attachments found = " & AttCount & vbNewLine & "Total attachments= " & TotalAttCount)

Range("B3").Select
Selection = EmailCount
Range("B4").Select
Selection = AttCount

End Sub

 

[Worf]

At Excel > VBE > Tools > References, check Microsoft Outlook Object Library.