0
votes

We use a shared outlook email box and we need to save some of the attachments from that email. I need the macro to do:

  • Allow user to select multiple emails and save all the attachments in the selection
  • Allow the user to select what folder to save the attachments in (it will be different every time)
  • Add the ReceivedTime to the file name as we get some email attachments with the same name but they are always received on different days
  • Do not want to alter the original email in any way (don't delete the attachment or add a note to the email)

Here is the code I have, I have never written anything in Outlook before and I have combined different lines from macros that I have found. That being said the macro doesn't work. I get the error

"Runtime error 91: "object variable or With block variable not set" on both lines with "***"

. I remove the dateFormat from the macro and SaveAs and still get the runtime error on the SaveAs line.

Sub saveAttachment()
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem
    Dim objAtt As Outlook.Attachment
    Dim objSel As Outlook.Selection
    Dim lngCount As Long
    Dim sFolder As String
    Dim dateFormat As String
        ***dateFormat = Format(objMsg.ReceivedTime, "yyyy-mm-dd")***
    Dim xlObj As Excel.Application
    Set xlObj = New Excel.Application
    ' Open the select folder prompt
    With xlObj.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        ElseIf .Show = 0 Then
            MsgBox "Failed to select folder to save attachements to"
        Exit Sub
        End If
    End With
    xlObj.Quit
    Set xlObj = Nothing
Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
For Each objMsg In objSelection
 Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    If lngCount > 0 Then
    ***objAtt.SaveAsFile sFolder & "\" & objAtt.FileName & dateFormat***
Else
MsgBox "No attachements selected"
End If
Next
End Sub

We are utilizing Office365, in case that makes a difference. Any help would be greatly apperciated.

1
Hello, dateFormat = Format(objMsg.ReceivedTime, "yyyy-mm-dd") You are trying to access objMsg before it is assigned. If you move this code inside the loop below, it should work. objAtt.SaveAsFile sFolder & "\" & objAtt.FileName & dateFormat Same kind of problem: objAtt is never assigned. You would first have to loop on objAttachments and take action of each attachment. - dekingsey

1 Answers

0
votes

First of all, you need to place the Format method inside the loop where the mail item is accessible and instantiated. Then you need to make sure the file path is valid and no forbidden symbols are used in the file name.

Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
For Each objMsg In objSelection
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    If lngCount > 0 Then
      dateFormat = Format(objMsg.ReceivedTime, "yyyy-mm-dd")
      objAtt.SaveAsFile sFolder & "\" & objAtt.FileName & dateFormat
    Else
      MsgBox "No attachements selected"
    End If
Next

You may find the Getting started with VBA in Office article helpful.