Question

我想设置一个VBA，自动从子文件夹"Shipment MTD"中主题为Inbox\Reports的未读电子邮件下载附件，并将其保存到以下文件夹C:\My Documents\Daily Shipments

Public Sub SaveAttachments()
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem 'Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderpath As String
    Dim strDeletedFiles As String
    Dim dtDate As Date
    Dim sName As String

    ' Get the path to your My Documents folder
    strFolderpath = "C:\My Documents\Daily Shipment"
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("Reports")
    Set myTasks = Fldr.Items

    ' Select unread items with required subject line
    Set resultItems = myTasks.Restrict("[UnRead] = False AND [Subject] = ""Shipment MTD""")

    ' Get the collection of selected objects.
    Set objSelection = resultItems

    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice

    ' Set the Attachment folder.
    strFolderpath = strFolderpath & "\Daily Shipment\"

    ' Select attachements in messsage
    Set objAttachments = objMsg.Attachments

    ' Check each selected item for attachments.

    For Each resultItems In myTasks
        lngCount = objAttachments.Count

        If lngCount > 0 Then

            dtDate = objMsg.SentOn
            sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & Format(dtDate, "hhnnss", vbUseSystemDayOfWeek, vbUseSystem) & "-" 'include DTS

            For i = lngCount To 1 Step -1

                ' Get the file name.
                strFile = sName & objAttachments.Item(i).FileName
                ' Combine with the path to the Temp folder.
                strFile = strFolderpath & strFile

                ' Save the attachment as a file.
                objAttachments.Item(i).SaveAsFile strFile

            Next i
        End If

    Next

ExitSub:

        Set objAttachments = Nothing
        Set objMsg = Nothing
        Set objSelection = Nothing
        Set objOL = Nothing
End Sub

我想只选择报告文件夹中的未读电子邮件。似乎VBA没有正确选择它。

Answer 1

以下是更好的过滤器，按主题，未读和仅包含附件的项目进行过滤，您的代码也有很多错误

这是清理后的简短

Option Explicit
Public Sub SaveAttachments()
    ' Get the path to your My Documents folder
    Dim strFolderpath As String
        strFolderpath = "C:\Documents\Temp\"

    ' Instantiate an Outlook Application object.
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")
    Dim Fldr As Outlook.Folder
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("Flash Orders")

    Dim Filter As String
        Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & _
                           Chr(34) & " Like '%Shipment MTD%' AND " & _
                           Chr(34) & "urn:schemas:httpmail:hasattachment" & _
                           Chr(34) & "=1 AND " & _
                           Chr(34) & "urn:schemas:httpmail:read" & _
                           Chr(34) & "=0"

    Dim myTasks As Outlook.Items
    Set myTasks = Fldr.Items.Restrict(Filter)

    Dim i As Long
    Dim objMsg As Outlook.MailItem 'Object

    For i = myTasks.Count To 1 Step -1
        If myTasks(i).Class = olMail Then
            Set objMsg = myTasks(i)

            Dim dtDate As Date
                dtDate = objMsg.SentOn
            Dim sName As String
                sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & _
                        Format(dtDate, "hhnnss", vbUseSystemDayOfWeek, vbUseSystem)

            Dim strFile As String
            Dim objAttachment As Outlook.Attachment
            For Each objAttachment In objMsg.Attachments
                ' Get the file name.
                strFile = strFolderpath & sName & "-" & objAttachment.FileName
                Debug.Print strFile
                ' Save the attachment as a file.
                objAttachment.SaveAsFile strFile
            Next
        End If
    Next i

End Sub

保存特定收件箱子文件夹中指定主题的附件

1 个答案: