Reputation: 173
I get 2 different files forwarded to me in Outlook daily. I currently use the code below to automatically download the attachments that meet the criteria to a folder on my drive.
I was wondering if there is a way to edit this so that I can save the different files to two different folders. i.e. email with A in subject => save attachment to folder A, email with B in subject => save attachment to folder 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
I know nothing about VBA, I just found this code online.
Upvotes: 2
Views: 375
Reputation: 3670
Since it's a binary criterion (A or B), we don't need to consider both strings: if it contains A, save to folderA
. Else (which means it contains B) save to 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
Upvotes: 1
Reputation: 12499
You could also simply use Select Case
Example
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
Upvotes: 0