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)