Visual Basic Codes
Visual Basic > Internet Web Mail Stuff sample source codes

Save Outlook mail attachments from the Inbox to a directory

Save Outlook mail attachments from the Inbox to a directory

The following code saves all the attachments from your inbox to a specifed path.

'Purpose     :  Saves all the attachments in your Outlook inbox to a specified directory
'Inputs      :  sSaveToPath                         The path to save the attachments to.
'Outputs     :  Returns Error description if an error occurrs


Function OutlookSaveAttachments(ByVal sSaveToPath As String) As String
    Dim oOutlook As Object      'For Early Bound use Outlook.Application
    Dim oNameSpace As Object    'For Early Bound use Outlook.NameSpace
    Dim oInBox As Object        'For Early Bound use Outlook.MAPIFolder
    Dim oMailItem As Object     'For Early Bound use Outlook.MailItem
    Dim sMessage As String, lThisAttach As Long
    
    On Error GoTo ErrNoOutlook
    Set oOutlook = CreateObject("Outlook.Application")
    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set oInBox = oNameSpace.GetDefaultFolder(6)
    
    If Right$(sSaveToPath, 1) <> "\" Then
        sSaveToPath = sSaveToPath & "\"
    End If
    
    On Error Resume Next
    For Each oMailItem In oInBox.Items
        With oMailItem
            For lThisAttach = 1 To oMailItem.Attachments.Count
                If Len(Dir$(sSaveToPath & oMailItem.Attachments.Item(lThisAttach).FileName)) Then
                    'Delete the existing file
                    Kill sSaveToPath & oMailItem.Attachments.Item(lThisAttach).FileName
                End If
                oMailItem.Attachments.Item(lThisAttach).SaveAsFile sSaveToPath & oMailItem.Attachments.Item(lThisAttach).FileName
            Next
        End With
    Next
    Set oMailItem = Nothing
    Set oInBox = Nothing
    Set oNameSpace = Nothing
    Set oOutlook = Nothing
    Exit Function
ErrNoOutlook:
    OutlookSaveAttachments = Err.Description
    On Error GoTo 0 'Clear error object
End Function