Consulting

Results 1 to 5 of 5

Thread: Using VBA to automatically save attachment to network folder

  1. #1
    VBAX Newbie
    Joined
    Feb 2020
    Location
    Philippines
    Posts
    3
    Location

    Using VBA to automatically save attachment to network folder

    Hi there.

    I am currently using the below code to strip attachments out of inbound emails and save to a shared folder within my network

    Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
        Dim oAttachment As Outlook.Attachment
        Dim sSaveFolder As String
        sSaveFolder = "P:\OUTLOOKDUMP\"
     
        For Each oAttachment In MItem.Attachments
            oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
        Next
    End Sub
    What I am wanting to do is when the file is stripped and saved, to edit the name that it is saved as.

    Right now the file comes in as GENERIC_TEXT_123456789.pdf

    The Text is the same for each file... ONLY the numbers before the ".pdf" change. I would like to save the file as just that number.pdf

    How do I go about doing this???

  2. #2
    Assuming the 'generic text' doesn't include any numbers then

    Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
    
    Dim oAttachment As Outlook.Attachment
    Dim sName As String
    Const sSaveFolder As String = "P:\OUTLOOKDUMP\"
        For Each oAttachment In MItem.Attachments
            If Right(LCase(oAttachment.fileName), 3) = "pdf" Then
                sName = GetNum(oAttachment.fileName) & ".pdf"
                oAttachment.SaveAsFile sSaveFolder & sName
            End If
        Next
    End Sub
    
    Private Function GetNum(sText As String) As String
    Dim i As Integer
        For i = 1 To Len(sText)
            If Mid(sText, i, 1) >= "0" And Mid(sText, i, 1) <= "9" Then
                GetNum = GetNum + Mid(sText, i, 1)
            End If
        Next
    lbl_Exit:
        Exit Function
    End Function
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Newbie
    Joined
    Feb 2020
    Location
    Philippines
    Posts
    3
    Location
    Quote Originally Posted by gmayor View Post
    Assuming the 'generic text' doesn't include any numbers then

    Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
    
    Dim oAttachment As Outlook.Attachment
    Dim sName As String
    Const sSaveFolder As String = "P:\OUTLOOKDUMP\"
        For Each oAttachment In MItem.Attachments
            If Right(LCase(oAttachment.fileName), 3) = "pdf" Then
                sName = GetNum(oAttachment.fileName) & ".pdf"
                oAttachment.SaveAsFile sSaveFolder & sName
            End If
        Next
    End Sub
    
    Private Function GetNum(sText As String) As String
    Dim i As Integer
        For i = 1 To Len(sText)
            If Mid(sText, i, 1) >= "0" And Mid(sText, i, 1) <= "9" Then
                GetNum = GetNum + Mid(sText, i, 1)
            End If
        Next
    lbl_Exit:
        Exit Function
    End Function
    Dude... seriously amazing! Thank you!

    one thing that i forgot about, and I do not know if there is a way to resolve in the renaming convention.

    There are times where at the end of the numbers, and right before the ".pdf" that the final character is an "X". Is there a way to make it so that it does not strip the X??

  4. #4
    Change the function to
    Private Function GetNum(sText As String) As String
    Dim i As Integer
        For i = 1 To Len(sText)
            If Mid(sText, i, 1) >= "0" And Mid(sText, i, 1) <= "9" Then
                GetNum = GetNum + Mid(sText, i, 1)
            End If
        Next
        If IsNumeric(Mid(sText, Len(sText) - 4, 1)) = False Then
            GetNum = GetNum & Mid(sText, Len(sText) - 4, 1)
        End If
    lbl_Exit:
        Exit Function
    End Function
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Newbie
    Joined
    Feb 2020
    Location
    Philippines
    Posts
    3
    Location
    Quote Originally Posted by gmayor View Post
    Change the function to
    Private Function GetNum(sText As String) As String
    Dim i As Integer
        For i = 1 To Len(sText)
            If Mid(sText, i, 1) >= "0" And Mid(sText, i, 1) <= "9" Then
                GetNum = GetNum + Mid(sText, i, 1)
            End If
        Next
        If IsNumeric(Mid(sText, Len(sText) - 4, 1)) = False Then
            GetNum = GetNum & Mid(sText, Len(sText) - 4, 1)
        End If
    lbl_Exit:
        Exit Function
    End Function
    Thank you!

Posting Permissions

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