Hi Everyone,
Briefly...
Goal:
To move daily emails sent to a secondary inbox --- i.e., sent from a specific email address---to a sub-folder (Reports) and save the attachment to a location on our network.
System Specifics:
OS: Windows 7 Pro & Windows 10
Outlook: version 365
Email server: Microsoft Exchange
Progress:
I have some VBA that I found on via Google which someone else has gotten to work. However, there are some differences in my situation.
1) I have two email accounts---a primary one (my own email address) and secondary account (an email group called: LogisticsSupport, that has a group email address, the send to!). I would like to VBA to refer to the secondary group email account/address.
2) The folder I wish to download attachments to is on a network drive: see pic for details (email addresses & folderpath disguised)
Attachment 27971
VBA so far:
I've put this code into: ThisOutlookSession (not a module). As far as I understand it, when Outlook opens, the VBA directs an inbox search for mail sent from the senders email address (see pic) to the secondary email account (see pic). I think I need to refer specifically to the secondary email account somehow in order for it to search the correct inbox (see picture for details).Private WithEvents Items As Outlook.Items 'location to save in. Can be root drive or mapped network drive. '-->As it is a constant you can declare it there (and so, use it in the whole module if you want to do other things with it!) Private Const attPath As String = "S:etc" 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 If TypeName(item) = "MailItem" Then Dim Msg As Outlook.MailItem '-->Use directly the parameter and keep it under wraps using "With", it'll improve efficiency With item 'Change variables to match need. Comment or delete any part unnecessary. If (.SenderEmailAddress = "reports email address (below pic/instagram-post)" _ Or .Subject = "LOG Leicester | Weekly Despatches by Courier and Customer" _ ) _ And .Attachments.Count >= 1 Then Dim aAtt As Outlook.Attachment '-->Loop through the Attachments' collection For Each aAtt In item.Attachments '-->You can either use aAtt.DisplayName or aAtt.FileName '-->You can test aAtt.Size or aAtt.Type 'save attachment aAtt.SaveAsFile attPath & aAtt.DisplayName Next aAtt 'mark as read .UnRead = False Dim olDestFldr As Outlook.MAPIFolder Set FldrDest = Session.folders("LogisticsSupport").folders("Inbox").folders("Reports") If .Parent.Name = "Reports" And .Parent.Parent.Name = "Inbox" Then 'MailItem is already in destination folder Else Set Msg = .Move(FldrDest) MsgBox Msg.SenderEmailAddress & vbCrLf & Msg.Subject 'Msg.delete End If End If End With 'item End If ProgramExit: Exit Sub ErrorHandler: MsgBox Err.Number & " - " & Err.Description Resume ProgramExit End Sub
Please would you help me understand/modify this VBA to do the job?