如何将具有不同条件的附件保存到Outlook中的两个不同文件夹中?

时间:2019-07-06 22:18:58

标签: vba outlook outlook-vba

我每天在Outlook中收到2个不同的文件转发给我。我目前使用下面的代码自动将符合条件的附件下载到驱动器上的文件夹中。

我想知道是否可以编辑此文件,以便将不同的文件保存到两个不同的文件夹中。即,主题为A的电子邮件=>将附件保存到文件夹A,主题为B的电子邮件=>将附件保存到文件夹B。

Public Sub SaveOutlookAttachmentsToDisk(MItem As Outlook.MailItem)
    Dim oOutlookAttachment As Outlook.Attachment
    Dim sSaveAttachmentsFolder As String
    sSaveAttachmentsFolder = "C:\Users\mason\Desktop\Email Pricing\"
    For Each oOutlookAttachment In MItem.Attachments
        oOutlookAttachment.SaveAsFile sSaveAttachmentsFolder & 
        oOutlookAttachment.DisplayName
    Next
End Sub

我对VBA一无所知,我只是在网上找到此代码。

2 个答案:

答案 0 :(得分:1)

由于它是一个二进制准则(A或B),因此我们不需要考虑两个字符串:如果它包含A,则保存为folderA。否则(表示它包含B)保存到folderB

Public Sub SaveOutlookAttachmentsToDisk(MItem As Outlook.MailItem)

    Dim oAttach As Outlook.Attachment
    Dim FolderA As String, FolderB As String, StringA As String

    FolderA = "C:\Users\mason\Desktop\Email Fast Racks\"
    FolderB = "C:\Users\mason\Desktop\Email FTS Pricing\"
    StringA = "Fast Racks East Coast"
    For Each oAttach In MItem.Attachments

            If UCase(oAttach.FileName) Like "*.CSV" Then
                If InStr(MItem.Subject, StringA) > 0 Then
                    oAttach.SaveAsFile FolderA & oAttach.DisplayName
                Else
                    oAttach.SaveAsFile FolderB & oAttach.DisplayName
                End If
            End If

    Next oAttach

End Sub

答案 1 :(得分:0)

您也可以只使用 Select Case

示例

Public Sub SaveOutlookAttachmentsToDisk(MItem As Outlook.MailItem)
    Dim oOutlookAttachment As Outlook.Attachment
    Dim sSaveAttachmentsFolder As String

    Debug.Print MItem.Subject

    Select Case MItem.Subject
            '// subject line A
        Case "AAAA"
            sSaveAttachmentsFolder = "C:\Users\mason\Desktop\Email Pricing\AAAA\"
            '// subject line B
        Case "BBBB"
            sSaveAttachmentsFolder = "C:\Users\mason\Desktop\Email Pricing\BBBB\"
        Case Else
            Debug.Print "Subject not found"
            Exit Sub
    End Select

    For Each oOutlookAttachment In MItem.Attachments
        oOutlookAttachment.SaveAsFile sSaveAttachmentsFolder & oOutlookAttachment.DisplayName
    Next
End Sub