Question

I’m trying to find a way to get mail attachments (programaticaly) , and then open it… can someone tell me how to do this or point me to a right direction?

Answer 1

This is a VBA script (use in a Macro in Outlook) which will loop over all attachments in all selected items in the current folder and Save them to disk.

It should get you started and I don’t think it would take much to add some kind of process launch rather than save logic to it.

 Public Sub SaveAttachments()

  'Note, this assumes you are in the a folder with e-mail messages when you run it.
  'It does not have to be the inbox, simply any folder with e-mail messages

  Dim Exp As Outlook.Explorer
  Dim Sel As Outlook.Selection

  Dim AttachmentCnt As Integer
  Dim AttTotal As Integer
  Dim MsgTotal As Integer

  Dim outputDir As String
  Dim outputFile As String
  Dim fileExists As Boolean
  Dim cnt As Integer

  'Requires reference to Microsoft Scripting Runtime (SCRRUN.DLL)
  Dim fso As FileSystemObject

  Set Exp = Application.ActiveExplorer

  Set Sel = Exp.Selection
  Set fso = New FileSystemObject

  outputDir = "C:\Path"
  If outputDir = "" Then
    MsgBox "You must pick an directory to save your files to. Exiting SaveAttachments.", vbCritical, "SaveAttachments"
    Exit Sub
  End If

   Dim att As Attachment

  'Loop thru each selected item in the inbox
  For cnt = 1 To Sel.Count
    'If the e-mail has attachments...
    If Sel.Item(cnt).Attachments.Count > 0 Then
      MsgTotal = MsgTotal + 1

      'For each attachment on the message...
      For AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count
        'Get the attachment

        Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt)
        outputFile = att.FileName

        outputFile = Format(Sel.Item(cnt).ReceivedTime, "yyyy-mm-dd_hhmmss - ") + outputFile

        fileExists = fso.fileExists(outputDir + outputFile)

        'Save it to disk if the file does not exist
        If fileExists = False Then
          att.SaveAsFile (outputDir + outputFile)
          AttTotal = AttTotal + 1
        End If

        Set att = Nothing

        Sel.Item(cnt).Close (Outlook.OlInspectorClose.olDiscard)

      Next
    End If
  Next

  'Clean up
  Set Sel = Nothing
  Set Exp = Nothing
  Set fso = Nothing

  'Let user know we are done
  Dim doneMsg As String
  doneMsg = "Completed saving " + Format$(AttTotal, "#,0") + " attachments in " + Format$(MsgTotal, "#,0") + " Messages."
  MsgBox doneMsg, vbOKOnly, "Save Attachments"

  Exit Sub

ErrorHandler:

  Dim errMsg As String
  errMsg = "An error has occurred. Error " + Err.Number + " " + Err.Description
  Dim errResult As VbMsgBoxResult
  errResult = MsgBox(errMsg, vbAbortRetryIgnore, "Error in Save Attachments")
  Select Case errResult
    Case vbAbort
      Exit Sub

    Case vbRetry
      Resume

    Case vbIgnore
      Resume Next

  End Select

End Sub