Outlook附件文件名导出至Excel时部分空白的VBA代码调整需求问询

It looks like the issue is with how your code identifies hidden attachments and retrieves filenames for system-generated PDFs. These automated PDFs often use MAPI properties differently than regular user attachments—sometimes their FileName property is empty, or they're incorrectly flagged as hidden by your current check.

Here's how to adjust your code to capture all attachment filenames properly:

1. Update the IsHiddenAttachment Function #

Your current function marks any attachment with a PR_ATTACH_CONTENT_ID as hidden, but system PDFs might have this property set even if they're visible attachments. We'll refine this check to only flag attachments that are truly embedded (like inline images in emails):

Function IsHiddenAttachment(olkAtt As Outlook.Attachment) As Boolean
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
    Dim olkPA As Outlook.PropertyAccessor, varContentID As Variant, varHidden As Variant
    
    On Error Resume Next
    Set olkPA = olkAtt.PropertyAccessor
    
    ' Check if the attachment is marked as hidden via MAPI property
    varHidden = olkPA.GetProperty(PR_ATTACHMENT_HIDDEN)
    ' Check if it has a content ID (for inline images) AND is not an embedded message
    varContentID = olkPA.GetProperty(PR_ATTACH_CONTENT_ID)
    
    IsHiddenAttachment = (varHidden = True) Or _
                        (varContentID <> "" And olkAtt.Type <> olEmbeddeditem)
    On Error GoTo 0
    Set olkPA = Nothing
End Function

2. Add a Fallback to Retrieve Filename from MAPI Property #

When olkAtt.FileName is blank (common for system-generated attachments), we can pull the filename directly from the PR_ATTACH_FILENAME MAPI property. Modify the loop where you build strAtt:

strAtt = ""
For Each olkAtt In olkMsg.Attachments
    If Not IsHiddenAttachment(olkAtt) Then
        Dim attFileName As String
        attFileName = olkAtt.FileName
        
        ' Fallback to MAPI property if FileName is empty
        If attFileName = "" Then
            Const PR_ATTACH_FILENAME = "http://schemas.microsoft.com/mapi/proptag/0x3704001E"
            Dim olkPA As Outlook.PropertyAccessor
            Set olkPA = olkAtt.PropertyAccessor
            attFileName = olkPA.GetProperty(PR_ATTACH_FILENAME)
            Set olkPA = Nothing
        End If
        
        strAtt = strAtt & attFileName & ", "
    End If
Next

Why This Works #

• The updated IsHiddenAttachment function uses two checks: it only flags attachments explicitly marked as hidden, or inline images (content ID set and not an embedded message). This prevents system PDFs from being incorrectly filtered out.
• The fallback to PR_ATTACH_FILENAME ensures we get the filename even when the standard FileName property is empty, which is a common quirk of automated system attachments.

Full Modified Code Snippet (Key Sections) #

Here's how the relevant parts of your ExportMessagesToExcel sub will look after changes:

'Write messages to spreadsheet
For Each olkMsg In Application.ActiveExplorer.CurrentFolder.Items
    'Only export messages, not receipts or appointment requests, etc.
    If olkMsg.Class = olMail Then
        'Add a row for each field in the message you want to export
        excWks.Cells(intRow, 1) = olkMsg.ReceivedTime
        excWks.Cells(intRow, 2) = GetSMTPAddress(olkMsg, intVersion)
        excWks.Cells(intRow, 4) = olkMsg.Subject
        excWks.Cells(intRow, 5) = olkMsg.To
        excWks.Cells(intRow, 6) = olkMsg.CC
        
        strAtt = ""
        For Each olkAtt In olkMsg.Attachments
            If Not IsHiddenAttachment(olkAtt) Then
                Dim attFileName As String
                attFileName = olkAtt.FileName
                
                ' Fallback to MAPI property if FileName is empty
                If attFileName = "" Then
                    Const PR_ATTACH_FILENAME = "http://schemas.microsoft.com/mapi/proptag/0x3704001E"
                    Dim olkPA As Outlook.PropertyAccessor
                    Set olkPA = olkAtt.PropertyAccessor
                    attFileName = olkPA.GetProperty(PR_ATTACH_FILENAME)
                    Set olkPA = Nothing
                End If
                
                strAtt = strAtt & attFileName & ", "
            End If
        Next
        
        If strAtt <> "" Then
            strAtt = Left(strAtt, Len(strAtt) - 2)
        End If
        excWks.Cells(intRow, 3) = strAtt
        intRow = intRow + 1
    End If
Next

And replace your original IsHiddenAttachment function with the updated one above.

Test this with your system-generated PDFs—you should now see their filenames appear in the Excel output instead of blanks.

内容的提问来源于stack exchange，提问作者Tay