Consulting

Results 1 to 17 of 17

Thread: Attachment receiving from Specific User and Save Attachment base on Attachment Name

  1. #1
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location

    Post Attachment receiving from Specific User and Save Attachment base on Attachment Name

    Hi Genius,

    i am looking for outlook VBA which save attachment from specific User and save on hard drive(outlook event) ,But save location base on attachment name eg:-300-4567834 attachment should save under folder name 300 . There are more than 50 customers.So do i need to create if function 50 times? or any other method? i have found many example but i unable find suitable code eventually.


    Could you help ?

    Thanks................

  2. #2
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    Any one can help?

  3. #3
    Assuming that all the required filenames are in a similar format of 3 digits hyphen 7 digits, then it is fairly simple. Create a rule to identify messages from the specific sender and associate the following script with that rule. The attachment will be saved to the folder named from the first three digits, which will be created if not present. I have included a test macro so that you can test it on an existing message.

    Option Explicit
    
    Sub SaveAttachment(Item As Outlook.MailItem)
    'Graham Mayor - https://www.gmayor.com - Last updated - 04 Jul 2019
    Dim olAtt As Attachment
    Dim strFileName As String
    Dim strName As String
    Dim strFolder As String
        strFolder = Environ("USERPROFILE") & "\Documents\"
        If Item.Attachments.Count > 0 Then
            For Each olAtt In Item.Attachments
                strName = Left(olAtt.fileName, InStrRev(olAtt.fileName, ".") - 1)
                If strName Like "???-???????" Then
                    strFolder = strFolder & Split(strName, "-")(0) & Chr(92)
                    CreateFolders strFolder
                    olAtt.SaveAsFile strFolder & olAtt.fileName
                    Exit For
                End If
            Next olAtt
        End If
    lbl_Exit:
        Set olAtt = Nothing
        Exit Sub
    End Sub
    
    
    Private Sub CreateFolders(strPath As String)
    'A Graham Mayor/Greg Maxey AddIn Utility Macro
    Dim oFSO As Object
    Dim lng_PathSep As Long
    Dim lng_PS As Long
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        lng_PathSep = InStr(3, strPath, "\")
        If lng_PathSep = 0 Then GoTo lbl_Exit
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Do
            lng_PS = lng_PathSep
            lng_PathSep = InStr(lng_PS + 1, strPath, "\")
            If lng_PathSep = 0 Then Exit Do
            If Len(Dir(Left(strPath, lng_PathSep), vbDirectory)) = 0 Then Exit Do
        Loop
        Do Until lng_PathSep = 0
            If Not oFSO.FolderExists(Left(strPath, lng_PathSep)) Then
                oFSO.CreateFolder Left(strPath, lng_PathSep)
            End If
            lng_PS = lng_PathSep
            lng_PathSep = InStr(lng_PS + 1, strPath, "\")
        Loop
    lbl_Exit:
        Set oFSO = Nothing
        Exit Sub
    End Sub
    
    
    Sub TestMacro()
    Dim olMsg As MailItem
        On Error Resume Next
        Set olMsg = ActiveExplorer.Selection.Item(1)
        SaveAttachment olMsg
    lbl_Exit:
        Set olMsg = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    Today, 09:25 AM
    gmayor Thanks Lot
    i will check and update


  5. #5
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    If any mail has more than one attachment how to change code ? (currently tested but not save other attachment )

    Also following code "CreateFolders strFolder" dosent work

    Therefore i have created folder and run rule.

    Thanks

  6. #6
    If it is another attachment with the same name format then remote the line Exit For so the loop doesn't stop at the first one.

    Did you include the CreateFolders function in the module? If so, then it will work provided you have write permission at the location and you ensure that if you change
    strFolder = Environ("USERPROFILE") & "\Documents\"
    (the My Documents folder) to a folder of your choice you retain the end slash.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    Option Explicit
    Sub SaveAttachment(Item As Outlook.MailItem)
    'Graham Mayor - https://www.gmayor.com - Last updated - 04 Jul 2019
    Dim olAtt As Attachment
    Dim strFileName As String
    Dim strName As String
    Dim strFolder As String
        strFolder = Environ("USERPROFILE") & "\Documents\"
        If Item.Attachments.Count > 0 Then
            For Each olAtt In Item.Attachments
                strName = Left(olAtt.fileName, InStrRev(olAtt.fileName, ".") - 1)
                If strName Like "???-???????" Then
                    strFolder = strFolder & Split(strName, "-")(0) & Chr(92)
                    CreateFolders strFolder
                    olAtt.SaveAsFile strFolder & olAtt.fileName
                    Exit For
                End If
            Next olAtt
        End If
    lbl_Exit:
        Set olAtt = Nothing
        Exit Sub
    End Sub
    i have added above code but multiple attachments are not saving in folders i was trying many times make correct but it couldn't

    Thanks in advance Graham Mayor

  8. #8
    There was a typo in my last message it should have read REMOVE the line Exit For. That line is still present.
    Delete the line
    Exit For
    as this stops the process after the first found attachment.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    Thanks lot i remove "Exit For" then save first attachment but when save second attachment error occurred. "Cannot Save the attachment,Path doesnt exist.Verify the path is correct.

  10. #10
    Doh! My fault I forgot to move the folder definition into the loop so it is recreated for each attachment.


    Sub SaveAttachment(Item As Outlook.MailItem)'Graham Mayor - https://www.gmayor.com - Last updated - 05 Jul 2019
    Dim olAtt As Attachment
    Dim strFileName As String
    Dim strName As String
    Dim strFolder As String
        If Item.Attachments.Count > 0 Then
            For Each olAtt In Item.Attachments
                strFolder = Environ("USERPROFILE") & "\Documents\"
        	    strName = Left(olAtt.fileName, InStrRev(olAtt.fileName, ".") - 1)
                If strName Like "???-???????" Then
                    strFolder = strFolder & Split(strName, "-")(0) & Chr(92)
                    CreateFolders strFolder
                    olAtt.SaveAsFile strFolder & olAtt.fileName
                End If
            Next olAtt
        End If
    lbl_Exit:
        Set olAtt = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    Thanks gmayor for your valuable support!!!!! its works fine If you can please help me to following changes.

    1.i want to check condition first five letters only eg;- ?????- After dash no need to check any condition.

    Also some folders link with system therefore unable to change name eg: one of attachment send with 00161-344577558585 but folder name is 161 so can give ignore zero and save in 161 folder


  12. #12
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    Thanks gmayor for your valuable support!!!!! its works fine If you can please help me to following changes.

    1.i want to check condition first five letters only eg;- ?????- After dash no need to check any condition.

    Also some folders link with system therefore unable to change name eg: one of attachment send with 00161-344577558585 but folder name is 161 so can give ignore zero and save in 161 folder


  13. #13
    Change the lines to

    If strName Like "*???-?????*" Then
                    strFolder = strFolder & Int(Split(strName, "-")(0)) & Chr(92)
    However there's an old expression from the late Gilbert Briggs, a UK loudspeaker pioneer: 'The wider you open the window, the more dirt flies in'. The above string while working for the number sequences you have suggested, will also work with others that you may not want.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  14. #14
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    Hi gmayor thanks Master your valuable support i want to learn this kind of stuff. i am following some tutorial from Youtube .But still child for VBA ...

  15. #15
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    could i use if condition for "?????-??????*" if attachment has first 3 digit (before dash)run this loop or or 5 digit run this loop .
    because attachment is system generated couldn't change rename part ( 5 digits attachment name)

  16. #16
    VBAX Regular
    Joined
    Sep 2018
    Posts
    23
    Location
    i found solution i made two sub for each condition and it works

  17. #17
    Decent, need to accomplish something like this with mine.

Tags for this Thread

Posting Permissions

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