Rename a file before attaching it to Outlook email-CodePudding

Does anyone know how I can edit the name of a .pdf file before attaching it to Outlook. You see I have a 10 digits value inside R.Offset(0, 3) cell in the following format: 0000000000 I want the program to use this value to find the file in a folder with the following format: "0000000000_FIRST_MIDDLE_LAST_STATEMENT" Those 10 digits are GDPR sensitive so I have to remove them from the name of the file. I have around 1000 emails per month that I have to do this to so it's a extremellty tedious. I guess it has to concatinate somehow but my knowledge is not sufficient. Also worth mentioning sometimes those 10 numers are like this 0000000000-1 and sometimes are 8 numbers: 00000000

Will appriciate if you someone has tips on this

Credits for the code: https://www.youtube.com/watch?v=k8yE3Bh_5_s

Sub SendEmailFromExcel()

Dim EApp As Outlook.Application
Set EApp = New Outlook.Application
Dim EItem As Outlook.MailItem
Set EItem = EApp.CreateItem(olMailItem)
Dim path As String
Dim strbody
path = "\" 'put your path here
Dim RList As Range
Set RList = Range("A2", Range("a2").End(xlDown))
Dim R As Range

    strbody = "<p >template</p>" 


For Each R In RList
    Set EItem = EApp.CreateItem(0)
        With EItem
        .SentOnBehalfOfName = ("team_email")
        .To = R.Offset(0, 1)
        .Subject = R.Offset(0, 0)
        .Attachments.Add (path & R.Offset(0, 3)   ".pdf")
        .Display
        .HTMLBody = strbody & .HTMLBody
End With
Next R
Set EApp = Nothing
Set EItem = Nothing
End Sub

CodePudding user response：

The following script is to replace your For..Next loop. The rest can stay as is. It's untested, but the theory is sound I believe..

Dim foundfile As String, newfilename As String, TempPath As String

TempPath = Environ$("temp") & "\"
If Right(Path, 1) <> "\" Then Path = Path & "\"

For Each R In RList

    'Find file that starts with number
    foundfile = Dir(Path & R.Offset(0, 3) & "*.pdf")
    
    'if file is found then..
    If foundfile <> "" Then
        'create new filename that excludes number
        newfilename = Mid(foundfile, InStr(foundfile, "_")   1)
        
        'if file already exists in temp location, delete it
        If Dir(TempPath & newfilename) <> "" Then Kill TempPath & newfilename
        
        'create copy of file with short name in temp location
        FileCopy Path & foundfile, TempPath & newfilename
        
        Set EItem = EApp.CreateItem(0)
        With EItem
            .SentOnBehalfOfName = ("team_email")
            .To = R.Offset(0, 1)
            .Subject = R.Offset(0, 0)
            ' add attachment from temp location
            .Attachments.Add (TempPath & newfilename)
            .Display
            .HTMLBody = strbody & .HTMLBody
        End With
        'remove temporary copy
        Kill TempPath & newfilename
    Else
        'File not found
    End If
    
Next R