VBA for incoming email and saving it in specified folder

[albertan]

I'm trying to get the file attachment coming from a specified email (comes daily 3 times) and save it in a specified folder.(overwriting it each time new report comes) Using this VBA code but it's not working. Is there any resource or link you can perhaps recommend?

code.jpg

[June7]

Please post code as text between CODE tags, not image.

"Not working" means what - error message, wrong result, nothing happens?

Review https://stackoverflow.com/questions/...ing-access-vba

[Aussiebear]

Here you go June7

[Sub MoveandSaveFile()
Dim ns as Outlook.NameSpace
Dim Folder as Outlook.folder
Dim items as Outlook.items
Dim item as Object
Dim Attachment as Outlook.attachment
Dim saveFolder as String
Dim saveName as String
Dim moveFolder as Outlook.folder
Dim filePath as String
‘Set the save folder and file name
saveFolder = “C:\Users\ME\Documents\2023\Source Reports\”
saveName = “Margin_Feb_2023.xlsb”
‘get the folder containing the emails
Set ns = Application.GetNameSpace(“MAPI”)
Set Folder = ns.GetDefaultFolder(olFolderInbox)
‘Filter emails by Sender and Subject
Set items = folder.items.Restrict (“[SenderEmailAddress] = ‘ReportScheduler@yahoo.com’  _ 
AND [Subject] = ‘Margin File’ “)
‘Loop through the emails
For each Item in Items
   ‘Loop through the attachments
      For each attachment in Items.Attachments
         ‘Check if the attachment is the desired file
         If Attachment.FileName = “Margin Integrity File” Then
            ‘Save the attachment to the specified file
           Attachment.SaveAsFile savefolder & saveName
           ‘Move the email to the A Reports folder
           Set movefolder = ns.GetDefaultFolder(olfolderInbox).Folders(“A Reports”)
           item.Move movefolder
           ‘Set the file path and overwrite the file
           filePath = saveFolder & saveName
           Kill filepath
           FileCopy attachment.FileName, filePath
       End If
   Next Attachment
Next Item
End Sub

[albertan]

Thank you for helping to paste the code ( I tried to paste the code initially and it gave me an error).
Is there something wrong with this code, I wonder why it's not working? Thank you

[June7]

Again, "not working" means what - error message, wrong result, nothing happens?

Are you running this VBA behind Outlook or Excel or Access?

[albertan]

Thanks for your question.

I'm using this VBA code in MS Outlook. I enabled all references, as I think (i.e. Microsoft Office 16.0 Library, Microsoft Office Object Library, Microsoft Forms 2.0 Object Library, Microsoft Scripting Runtime). I run the code and nothing happens: no error message, not action. Tried to debug with each step and it's not showing any errors. Not sure what's happening.

[gmayor]

If you are getting the messages regularly, then you will want to automate this.
Run the first macro as a script associated with a rule that either selects messages from a specific address, or all messages as it looks for the particular attachment, which I assume will only apply to specific messages.
You can test the script by selecting a suitable message in the inbox and run the test macro.
Provided the folder and path exist the macro will save the attachment and move the message when the message arrives.
Note I have named the message to include the current month and year from the message so you don't have to edit the macro each month.

Sub SaveReport(olItem As MailItem)
'Graham Mayor - https://www.gmayor.com - Last updated - 09 Mar 2023
Dim olAttach As Attachment
Dim olFolder As Folder
Dim strFname As String
Dim sMonth As String
Dim j As Long
Const strSaveName As String = '"C:\Users\ME\Documents\2023\Source Reports\Margin_"
    On Error Resume Next
    If olItem.Attachments.Count > 0 Then
        For j = 1 To olItem.Attachments.Count
            Set olAttach = olItem.Attachments(j)
            If LCase(olAttach.FileName) Like "*margin integrity file*" Then
                sMonth = Format(olItem.SentOn, "MMM_yyyy") & ".xlsb"
                olAttach.SaveAsFile strSaveName & sMonth
                Exit For
            End If
        Next j
        Set olFolder = Session.GetDefaultFolder(olFolderInbox).Folders("A Reports")
        olItem.Move olFolder
    End If
lbl_Exit:
    Set olAttach = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
    Exit Sub
End Sub

Sub TestMacro()
Dim olMsg As MailItem
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olMsg = ActiveInspector.currentItem
        Case olExplorer
            Set olMsg = Application.ActiveExplorer.Selection.item(1)
    End Select
    SaveReport olMsg
lbl_Exit:
    Exit Sub
End Sub

[June7]

Aussie, you must have used Word to convert code from PDF to text. That caused use of 'smart' apostrophes and quotes. VBA doesn't like them. Had to replace all.

[Aussiebear]

@ June7. Sure did, but simply typed out the contents of the image word for word.

[June7]

Aussie, if you're going 'above and beyond' by typing, could use WordPad or Notepad or Notepad++ because don't need 'rich text'.

[Aussiebear]

Aussie, if you're going 'above and beyond' by typing, could use WordPad or Notepad or Notepad++ because don't need 'rich text'.

I run a Mac system and prefer to use Word.

[albertan]

Thank you, I will give it a try

[albertan]

For some reason the test macro is only working by moving the email to my temp folder but file saving is not working. I pasted the first code in "run scripts" under Create Rule. I will keep researching. Thanks