Using VBA to automatically save attachment to network folder

[snuffnchess]

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

[gmayor]

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

[snuffnchess]

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

[gmayor]

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

[snuffnchess]

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!