Consulting

Results 1 to 7 of 7

Thread: Pulling attachment from the email send by particular email

  1. #1

    Pulling attachment from the email send by particular email

    Hello VBA guru,
    I am wondering if I can pull a/all the attachment sent by particular sender and save into specific folder. I am currently using outlook365.

    I have several following conditions.
    1) Only pull the attachment if it is in pdf.
    2) I want to have message box open so I can provide the email address that I want to download the attachment came from.
    3) I want macro to run and download the attachment only from the unread email/s.
    4) After I download the attachment and saved into shared drive, I want to make that email as read.
    5) If there is no folder into destination location, I want to create a folder and rename by the email address I provided on number 2( i.e. on message box).
    6) If there is already exist a same file, I want to skip this process. For instance if someone send same invoice twice, I don't want to have two invoices into the destination folder which is "K:\AP".
    7) I would like have a variable for location if it is going to use multiple times, it will be easy if in case I need to change the location in the future.


    I appreciate your help.

    Thank you.

  2. #2
    VBAX Mentor
    Joined
    Sep 2019
    Location
    Philippines
    Posts
    416
    Location
    what have you, at least, done so far?

  3. #3
    I don't have much knowledge in VBA, that's why not done anything.

  4. #4
    VBAX Newbie
    Joined
    Jul 2022
    Posts
    4
    Location
    I have a very similar requirement and have cobbled together this:

    Public Sub SaveAttachmentsToDisk(MItem As Outlook.mailItem)
    
    
    Dim oAttachment As Outlook.Attachment
    Dim sSaveFolder As String
    Dim jobID As String
    Dim Dest As String
    
    
    Dest = "Y:\!!1-Uplift\DBYD\" ' folder to save all DBYD attachments
    
    
    Debug.Print "Attachment Count=" & MItem.Attachments.Count
    
    
    If MItem.Attachments.Count = 0 Then Exit Sub
    
    
    On Error GoTo extSub
    
    ' Get job ID from Email subject (ND0000XXXX)
    If InStr(MItem.Subject, "ND") <> 0 Then
        jobID = Mid(MItem.Subject, InStr(MItem.Subject, "ND"), 11)
    ElseIf InStr(MItem.Subject, "Job No") <> 0 Then ' likely Jemina response
        jobID = Mid(MItem.Subject, InStr(MItem.Subject, "Job No "), 16)
        jobID = Replace(jobID, ",", "")
    Else
        jobID = "Unknown"
    End If
    
    
    strFolderExists = Dir(Dest & jobID & "\", vbDirectory) ' check if folder already exists
    
    
    If strFolderExists = "" Then
        MkDir Dest & jobID & "\" ' create job ID folder if it doesn't already exist
    End If
    
    
    fldr = MItem.SenderName ' set folder as senders name (not email address)
    
    If fldr = "" Then fldr = MItem.SenderEmailAddress ' if no sender name, fail over to email address
    
    
    Debug.Print "fldr=" & fldr
    
    
    strFolderExists = Dir(Dest & jobID & "\" & fldr & "\", vbDirectory) ' check if responder folder already exists
    
    
    If strFolderExists = "" Then
        MkDir Dest & jobID & "\" & fldr & "\" ' create responder folder if it doesn't already exist
    End If
    
    
    sSaveFolder = Dest & jobID & "\" & fldr & "\" ' set save destination
    
    
    For Each oAttachment In MItem.Attachments 
        If  oAttachment.DisplayName like "*PDF*" Then ' check if attachment is PDF if so, save to destination sSaveFolder 
            oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
        End If
    Next
    
    
    MItem.UnRead = False
    
    Exit Sub
    
    
    extSub:
    msgbox "Something went wrong"
    End Sub
    This code is triggered by a rule for any emails received from a specific email address.

    It can also be triggered manually by highlighting the email(s) in question and running this:

    Sub saveAttach()
        Dim x, mailItem As Outlook.mailItem
        For Each x In Application.ActiveExplorer.Selection
            If TypeName(x) = "MailItem" Then
                Set mailItem = x
                Call SaveAttachmentsToDisk(mailItem)
            End If
        Next
    End Sub
    It should be straightforward enough to change the fixed save location to a prompt.

    Cheers

  5. #5
    Thanks KSD050,
    Just wondering, I wanted to download the attachment if the email is sent by specific person (so I wanted to use email address as a input parameter and I want to give the email address into a message box), does the first macro work ? I can ignore the subject line because it can vary, that's why wanted to use email address as a criteria to download the attachment.

    Thank you again,

  6. #6
    VBAX Newbie
    Joined
    Jul 2022
    Posts
    4
    Location
    How do you want the process triggered?

    If you want the macro to run automatically based on the senders email address then having a rule set which triggers the macro would work (that's how I have it setup).

    If you want the macro to run manually based on a folder or selection of email then the second lot of code could be adapted to filter for a particular senders address

  7. #7
    I want macro to run automatically based on senders email but I want to use specific email address. Let's say sender email is info@abc.com, which is the line I am updating sender email into macro ? After I run this macro, all the email that is downloaded attachment should be convert as read and macro should be run only for unread emails on the sub-folder which was moved by rules. Lets say sub folder name I want to run the macro is "ABC".

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •