Hello everyone,
Been looking everywhere for help with this!
I'm trying to create a VBA macro to look through a specific inbox for unread e-mails with .pdf files attached to them, and then save them into a specific folder.
And so far I've been able to get the macro to do that.
The problem is that I need the macro to look through the inbox of certain account profile, as it seems my code would only work if there is just one Inbox folder and one account profile.
Let's say I have multiple profiles;
(MAIL1) Exchange ActiveSync
(MAIL2) IMAP/SMTP
(MAIL3) IMAP/SMTP
How do I get it to only run the code on the Inbox of the second account? (MAIL2)
The following is the code that I have so far, and if anyone could help me make the correct adjustments to it I'd be sincerely thankful ;
Sub GetAttachments()
On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim varResponse As VbMsgBoxResult
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0
' Checks inbox for messages.
If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in your Inbox.", vbInformation, _
"Nothing found"
Exit Sub
End If
' Checks inbox for unread messages.
If Inbox.UnReadItemCount = 0 Then
MsgBox "There are no new messages in your Inbox.", vbInformation, _
"Nothing found"
Exit Sub
End If
' Checks for unread messages with .pdf files attached to them, if yes then saves it to specific folder. _
Puts date and time from when the mail was created infront of the filename.
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
If Item.UnRead = True Then
If Right(Atmt.FileName, 3) = "pdf" Then
FileName = "C:\Users\XXX\Documents\Office Macro\" & _
Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
End If
Next Atmt
Next Item
' Shows how many attached files there are if any are found.
If i > 0 Then
varResponse = MsgBox("I've found " & i & " attached .pdf files." _
& vbCrLf & "Jag har sparat dem till C:\Users\XXX\Documents\Office Macro folder." _
& vbCrLf & vbCrLf & "Would you like to see your files?" _
, vbQuestion + vbYesNo, "Finished!")
If varResponse = vbYes Then
Shell "Explorer.exe /e,C:\Users\XXX\Documents\Office Macro\", vbNormalFocus
End If
Else
MsgBox "No attached files could be found.", vbInformation, _
"Finished!"
End If
' Rensar minnet.
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
' Felfixare.
GetAttachments_err:
MsgBox "An unkown ghost spooked the program." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
Exit Sub
End Sub