0

I have the following code in ThisOutlookSession. Only the second sub is saving to the folder. (When I had only the first part, this worked perfectly.)

Is there a way both files from different domains can be saved into their own folders?

I am using this to feed files into folders that Power BI goes into and takes the most recent file.

Private WithEvents Items As Outlook.Items
    
Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
    
Private Sub Items_ItemAdd(ByVal item As Object)
    
    On Error GoTo ErrorHandler
    
    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item
    
        'Change variables to match need. Comment or delete any part unnecessary.
        If (Msg.SenderName = "it-support@bdmlogistics.com") And _
          (Msg.Subject = "Please find attached your MTD Turnover Report") And _
          (Msg.Attachments.Count >= 1) Then
           
            'Set folder to save in.
            Dim olDestFldr As Outlook.MAPIFolder
            Dim myAttachments As Outlook.Attachments
            Dim Att As String
           
            'location to save in.  Can be root drive or mapped network drive.
            Const attPath As String = "C:\Users\John Smith\OneDrive - Company\Documents\OLAttachments\"
          
          
            ' save attachment
            Set myAttachments = item.Attachments
            Att = myAttachments.item(1).DisplayName
            myAttachments.item(1).SaveAsFile attPath & Att
           
            ' mark as read
            Msg.UnRead = False
       
        End If
    End If
       
    
ProgramExit:
    Exit Sub
     
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub
    
Private Sub Items_ItemAdd2(ByVal item As Object)
    
    On Error GoTo ErrorHandler
    
    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item
    
        'Change variables to match need. Comment or delete any part unnecessary.
        If (Msg.SenderName = "it-support@bdmlogistics.com") And _
          (Msg.Subject = "Stock Report by Batch") And _
          (Msg.Attachments.Count >= 1) Then
           
            'Set folder to save in.
            Dim olDestFldr As Outlook.MAPIFolder
            Dim myAttachments As Outlook.Attachments
            Dim Att As String
           
            'location to save in.  Can be root drive or mapped network drive.
            Const attPath As String = "C:\Users\John Smith\OneDrive - Company\Documents\Stock Reports\"
          
          
            ' save attachment
            Set myAttachments = item.Attachments
            Att = myAttachments.item(1).DisplayName
            myAttachments.item(1).SaveAsFile attPath & Att
           
            ' mark as read
            Msg.UnRead = False
       
        End If
    End If
       
    
ProgramExit:
    Exit Sub
     
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub
Community
  • 1
  • 1
  • 1
    Use a simple for-loop to loop over all `item.Attachments` instead of hardcode the index `1` as you do now – FunThomas Mar 03 '21 at 08:49
  • 1
    You may shift the 2 onto Items. `Private WithEvents Items2 As Items`, `Set Items2 = objNS.GetDefaultFolder(olFolderInbox).Items` and `Private Sub Items2_ItemAdd(ByVal item As Object)`. – niton Mar 03 '21 at 14:19
  • Thank you very much. I have made the adjustment and will be testing this tonight when the automatic emails come through. I really appreciate the help on this. – Maxwell Lay Mar 05 '21 at 12:45
  • Just to confirm - @niton, this worked perfectly. Many thanks! – Maxwell Lay Mar 08 '21 at 09:38

2 Answers2

1

The event is officially named ItemAdd. If that is changed to "ItemAdd2" it is no longer an event.

Instead of Private Sub Items_ItemAdd2(ByVal item As Object). you may change the prefix Items to Items2.

Normally this would be applicable when two folders are being monitored but can be used for the same folder.

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Private WithEvents Items As Items
Private WithEvents Items2 As Items

Private Sub Application_Startup()
    Dim myItems As Object
    Dim myItems2 As Object

    Set myItems = Session.GetDefaultFolder(olFolderInbox).items
    Set myItems2 = Session.GetDefaultFolder(olFolderInbox).items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
    ' ...
End Sub

Private Sub Items2_ItemAdd(ByVal item As Object)
    ' ...
End Sub
niton
  • 8,771
  • 21
  • 32
  • 52
0

When one folder is being monitored it is possible to use one ItemAdd.

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant

Const attPath = "C:\Users\John Smith\OneDrive - Company\Documents\OLAttachments\"
Const attPath2 = "C:\Users\John Smith\OneDrive - Company\Documents\Stock Reports\"

Private WithEvents myItems As Items

Private Sub Application_Startup()
    Dim myItems As Object
    Set myItems = Session.GetDefaultFolder(olFolderInbox).items
End Sub

Private Sub myItems_ItemAdd(ByVal item As Object)
    
    Dim myMsg As MailItem
    Dim myAttPath As String
    
    If TypeName(item) = "MailItem" Then
    
        Set myMsg = item

        If myMsg.SenderName = "it-support@company.com" Then
        
            If myMsg.Attachments.count > 0 Then
          
                Select Case myMsg.Subject
            
                    'location to save.
                    
                    Case "Please find attached your MTD Turnover Report"                        
                        myAttPath = AttPath
                        Debug.Print myAttPath
                  
                    Case "Stock Report by Batch"                        
                        myAttPath = AttPath2
                        Debug.Print myAttPath
                      
                End Select
        
                ' set folder
                Dim myAttachments As Attachments
                Dim myAttName As String
            
                ' save attachment
                Set myAttachments = item.Attachments
                myAttName = myAttachments.item(1).DisplayName
                myAttachments.item(1).SaveAsFile myAttPath & myAttName
             
                ' mark as read
                myMsg.UnRead = False
                
            End If
   
        End If
        
    End If
    
End Sub

Private Sub test()
    myItems_ItemAdd ActiveInspector.currentItem
End Sub
niton
  • 8,771
  • 21
  • 32
  • 52