none
VBA Outlook: Find specific attachment and save under different name RRS feed

  • Question

  • Good afternoon!

    Warning, my code is quite messy because I'm not good at this and I'm modifying another macro so for the time being keep everything until I know what I need. I also don't know whether I'm in the right forum. This looks very different from last time I posted.

    What I want to do is the following: I'm getting email with 2 or more attachments. I need the attachment that is named "Invoice_No_XXXX", XXXX being a different number in each case. So I need a wildcard in my search.

    I then want to save the email with the name "Company_XXXX", retaining the 4 digit invoice number.

    I have a macro that works but the email only has one attachment. And I don't know how I can get VBA to search and find the right attachment.

    Thanks, Christine

    Public Sub ISL()
    
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem 'Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderpath As String
    Dim strFileName As String
    Dim objSubject As String
    Dim objAtt As Object
    Dim strDeletedFiles As String
    Dim strInvoiceNo As String
    
    
    ' Get the path to your My Documents folder
    'strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next
    
    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")
    
    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection
    
    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice
    ' Set the Attachment folder.
    strFolderpath = "U:\INVOICES\"
    
    ' Check each selected item for attachments.
    For Each objMsg In objSelection
    
    'Set FileName to Subject
    objSubject = Mid(objMsg.Subject, 10, 4)
    ' Get the file name.
    strFileName = "ISL_" '& objSubject & ".pdf"
    
    Set objAttachments = objMsg.Attachments
    
        'save each mail attachment
                If Item.Attachment.Count > 0 Then
                    For Each objAtt In Item.Attachments
                        If objAtt.FileName Like "Invoice_No_*" Then
                            objAtt.Item(1).SaveAsFile strFolderpath & strFileName & Right(objAtt.DisplayName, 8)
                        End If
                    Next
                End If
    
    
    lngCount = objAttachments.Count
    If lngCount > 0 Then
    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.
    For i = lngCount To 1 Step -1
    
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFileName
    Debug.Print strFile
    
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile
    objMsg.UnRead = False
    Next i
    End If
    Next
    
    ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
    
    Exit Sub
    
    
    End Sub
    

    Friday, June 5, 2015 4:27 AM