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

Code:

---

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???

Assuming the 'generic text' doesn't include any numbers then

Code:

---

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

---

Quote:

---

Originally Posted by gmayor

Assuming the 'generic text' doesn't include any numbers then

Code:

---

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??

Change the function to

Code:

---

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

---

Quote:

---

Originally Posted by gmayor

Change the function to

Code:

---

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!