VBA - populating outlook "To" & "Subject" from Excel and attach .pdf from folder.

[miroe250]

I was wondering if this is even possible to be done with VBA.
I have to send roughly 1000 emails per month. They give me an excel with 2 collums: the first one is the full name which is the subject of the email and I search the .pdf that I need to attach. The second collum is the email of the receiver which I insert in the "To".
I've search in this forum and found this send multiple emails with spreadsheet attachments with a macro which is very close to the thing I need but I can't figure out how to change the code to accomodate my needs. ( i've tried adding additional variable and another loop, but I've been stuck even before that "Dim rng As Range, c As Range, i As Long, v As Variant, lastRow As Long", VBA says I didn't declare it and I can't figure what it wants.
Also there is a bit tricky part that I don't think is possible to be coded. There is 8 digits part of the name of the .pdf which is GDPR sensitive and I manually edit every .pdf before attaching it to the email, is it possible to edit the name of the .pdf and delete the first 8 digits.
Additionally I've already found a code to insert specify "From" ( team e-mail) and specific template of the body of the email. - credits :

Sub Send_from_another()

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "<p>template here</p>" & _

On Error Resume Next
With OutMail
.SentOnBehalfOfName = ("team email")
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Display
.HTMLBody = strbody & .HTMLBody

End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing


End Sub

 

[miroe250]

Ok did some progress thanks to ChatGPT.
It turns out I have to do the VBA in the excel itself, I was trying to do in OutLook.
Now this code successfully creates new emails and it fills To and Subject.
I had to scrap the idea to where the attachment had to be searched by the full name because 2 people can have the same full name. I didn't mention it but I had a third collum with this *10 digit unique identifier. So I can search by using this third collum and I still need to remove it from the name of the pdf.

Sub SendEmailFromExcel()
    Dim OutlookApp As Outlook.Application
    Dim OutlookMail As Outlook.MailItem
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim i As Long

    
    Set OutlookApp = New Outlook.Application
    Set ws = ThisWorkbook.Worksheets("sheet1") ' change "Sheet1" to the name of your worksheet
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' get the last row with data in column A
    
    strbody = "<p>template here</p>" & _

    For i = 2 To LastRow ' loop through the rows in the worksheet, starting at row 2 (row 1 is the header row)
        Set OutlookMail = OutlookApp.CreateItem(olMailItem) ' create a new email message
        With OutlookMail
            .SentOnBehalfOfName = ("teamemail")
            .To = ws.Cells(i, 1).Value ' set the "To" field to the value in column A of the current row
            .Subject = ws.Cells(i, 2).Value ' set the "Subject" field to the value in column B of the current row
            .Display ' display the email message so you can review it before sending
            .HTMLBody = strbody & .HTMLBody
        End With
    Next i
End Sub

Posting this if someone else needs it as it is now in a working condition.

Sub SendEmailFromExcel()
    Dim OutlookApp As Outlook.Application
    Dim OutlookMail As Outlook.MailItem
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Dim FileName As String
    Dim FilePath As String
    Dim SearchValue As String

    Set OutlookApp = New Outlook.Application
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' change "Sheet1" to the name of your worksheet
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' get the last row with data in column A

    For i = 2 To LastRow ' loop through the rows in the worksheet, starting at row 2 (row 1 is the header row)
        Set OutlookMail = OutlookApp.CreateItem(olMailItem) ' create a new email message
        With OutlookMail
            .To = ws.Cells(i, 1).Value ' set the "To" field to the value in column A of the current row
            .Subject = ws.Cells(i, 2).Value ' set the "Subject" field to the value in column B of the current row
            SearchValue = ws.Cells(i, 3).Value ' get the value in column C of the current row
            FilePath = "C:\path\to\folder\" ' change this to the path of the folder where the PDF files are located
            FileName = Dir(FilePath & "*" & SearchValue & "*.pdf") ' get the name of the PDF file with the search value in it
            FileName = Replace(FileName, SearchValue, "") ' remove the search value from the file name
            FileName = Replace(FileName, FilePath, "") ' remove the file path from the file name
            .Attachments.Add FilePath & FileName ' attach the PDF file to the email
            .Display ' display the email message so you can review it before sending
        End With
    Next i
End Sub

This is what ChatGPT have offered me for the attachment thing but it's not working, will appreciate if anyone helps me out here

 

[miroe250]

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

Scrapped and found another way to do it
Credits to this video:

So I'm at the final phase and probably the most difficult for me.
You see in this cell: R.offset(0,3) there are numbers 0000000000
I want to search for the file by that value and when it finds it in the folder to rename it excluding this numbers
and the file name is "0000000000_FIRTS_MIDDLE_LAST_Statement"
How do I get the attached file to be in this format "FIRST_MIDDLE_LAST_STATEMENT"?

 

[miroe250]

Well this is the sollution I've been looking for, if anyone has the same situatuion this would help him.

Rename a file before attaching it to Outlook email

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 pr...

stackoverflow.com