Outlook VBA获取邮件附件大小并写入Excel的问题求助

Got it, let's fix that attachment size issue for you! The core problem here is that you're trying to call .Size directly on the Attachments collection—this won't work because Attachments is a group of individual Attachment objects, and the collection itself doesn't have a Size property. That's why the MSDN Attachment.Size reference seemed unhelpful at first: you were applying it to the wrong object.

Solution: Loop Through Each Individual Attachment #

You need to iterate over every attachment in the current email's Attachments collection, then either calculate the total size of all attachments for the email, or record each attachment's size separately (depending on your needs).

Here's your updated code with the total attachment size fix:

Sub GetFromOutlook()
 Dim OutlookApp As Outlook.Application
 Dim OutlookNamespace As Namespace
 Dim OutlookMail As Variant
 Dim Folder As MAPIFolder
 Dim olItems As Outlook.Items
 Dim myItems As Outlook.Items
 Dim olShareName As Outlook.Recipient
 Dim dStart As Date
 Dim dEnd As Date
 Dim i As Integer
 Dim sFilter As String
 Dim sFilterLower As String
 Dim sFilterUpper As String
 Dim sFilterSender As String
 Dim totalAttachmentSize As Long ' Tracks total size of attachments per email
 Dim att As Outlook.Attachment ' Holds individual attachment objects
 '========================================================
 'Access shared mailbox
 '========================================================
 Set OutlookApp = New Outlook.Application
 Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
 Set olShareName = OutlookNamespace.CreateRecipient("teammailbox@example.ca")
 Set Folder = Session.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders("Subfolder1").Folders("Subfolder2")
 Set olItems = Folder.Items
 dStart = Range("From_Date").Value
 dEnd = Range("To_Date").Value
 '========================================================
 'Filter conditions for date range and sender
 '========================================================
 sFilterLower = "[ReceivedTime] > '" & Format(dStart, "ddddd h:nn AMPM") & "'"
 sFilterUpper = "[ReceivedTime] < '" & Format(dEnd, "ddddd h:nn AMPM") & "'"
 sFilterSender = "[SenderName] = ""jon.doe@example.com"""
 '========================================================
 'Apply filters to mail items
 '========================================================
 Set myItems = olItems.Restrict(sFilterLower)
 Set myItems = myItems.Restrict(sFilterUpper)
 Set myItems = myItems.Restrict(sFilterSender)
 '========================================================
 'Write email data to Excel
 '========================================================
 i = 1
 For Each myItem In myItems
     totalAttachmentSize = 0 ' Reset total for each new email
     ' Loop through all attachments in the current email
     For Each att In myItem.Attachments
         ' Skip inline attachments (like signature images, optional)
         If att.Type <> olEmbeddeditem Then
             totalAttachmentSize = totalAttachmentSize + att.Size
         End If
     Next att
     ' Populate Excel columns
     Range("eMail_subject").Offset(i, 0).Value = myItem.Subject
     Range("eMail_date").Offset(i, 0).Value = Format(myItem.ReceivedTime, "h:nn")
     Range("eMail_size").Offset(i, 0).Value = myItem.Size
     ' Add total attachment size (make sure you have this named range or adjust the cell reference)
     Range("eMail_attachment_size").Offset(i, 0).Value = totalAttachmentSize
     i = i + 1
 Next myItem
 ' Clean up objects
 Set Folder = Nothing
 Set OutlookNamespace = Nothing
 Set OutlookApp = Nothing
 Set att = Nothing
End Sub

Sub sbClearCellsOnlyData()
 Rows("5:" & Rows.Count).ClearContents
End Sub

Key Changes Breakdown: #

• New Variables: totalAttachmentSize accumulates the sum of valid attachment sizes per email, and att references each individual attachment in the collection.
• Attachment Loop: We iterate over every attachment in the email, adding its Size to the total. The att.Type <> olEmbeddeditem check skips inline attachments (like signature images) — remove this line if you want to include all attachments.
• Excel Output: Added a new column for total attachment size (adjust the named range eMail_attachment_size to match your sheet's setup if needed).

If You Need to Track Individual Attachments: #

If you want to list each attachment on its own row (instead of a total), adjust the loop like this:

For Each myItem In myItems
     ' Write email header data once
     Range("eMail_subject").Offset(i, 0).Value = myItem.Subject
     Range("eMail_date").Offset(i, 0).Value = Format(myItem.ReceivedTime, "h:nn")
     Range("eMail_size").Offset(i, 0).Value = myItem.Size
     ' Write each attachment on a new row
     For Each att In myItem.Attachments
         If att.Type <> olEmbeddeditem Then
             Range("eMail_attachment_name").Offset(i, 0).Value = att.FileName
             Range("eMail_attachment_size").Offset(i, 0).Value = att.Size
             i = i + 1
         End If
     Next att
     ' Increment row even if no attachments (adjust as needed)
     If myItem.Attachments.Count = 0 Then i = i + 1
 Next myItem

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