计数展望VBA附件

Question

你能帮我改善以下VBA代码，能够正确计算的电子邮件+附件形成一个选择的范围（如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 

这是代码的问题这也算作附件的签名照片，并给出一个错误计数这意味着更多的附件，那么实际上是

你能帮助修改代码在签名计算图像绕过

BR

加比

Answer 1

试试这个

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