VBA Macro, rookie with half finished code (Multiple accounts problem)

[teviga]

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

[teviga]

bump

[gmayor]

You could look for the named account store an d assign the folder to the inbox of that account e.g.



Dim oStore As Store
Dim oFolder As Folder
Dim bFound As Boolean
For Each oStore In Outlook.Session.Stores
If oStore = "MAIL2" Then
Set oFolder = oStore.GetDefaultFolder(olFolderInbox)
bFound = True
Exit For
End If
Next oStore
If Not bFound Then
MsgBox ("Account 'MAIL2' not found")
Exit Sub
End If

[teviga]

Thank you
Thank you
Thank you!!

This worked perfectly and with my non-existing programmings skills I managed to edit it a little so it matched the rest of my code.
Here's what I changed:


Dim oFolder As Folder

to


Dim Inbox As MAPIFolder


then


Set oFolder = oStore.GetDefaultFolder(olFolderInbox)

to


Set Inbox = oStore.GetDefaultFolder(olFolderInbox)