VBA Macro emails with word document attachment

Question

I am learning Excel VBA, I want to replace data from excel to word documents and send it to the staff via corresponding email on each line. Currently I have emailed, but I don't know how to best attach word documents, I have hundreds of employees. Thank you for everything.

Sub sendMail()
 
 Dim OApp As Outlook.Application
 Set OApp = CreateObject("Outlook.Application")
 
 Dim mail_number As Integer
 mail_number = Excel.WorksheetFunction.CountA(ThisWorkbook.Sheets(1).Range("B:B"))

 Dim row As Integer
 For row = 2 To mail_number
    
    ' Open word document
    
    ' Replace data from excel and create word document temporary file
    
    Dim OMail As Outlook.MailItem
    Set OMail = OApp.CreateItem(OMailItem)
    OMail.To = ThisWorkbook.Sheets(1).Cells(row, 2)
    
    'OMail.Attachments.Add( ... word document temporary file
    
    OMail.Send
    
    ' Release memory
    
 Next
 
End Sub

Answer 1

If I've understood your requirements, the following code may be helpful. Just to note, you may have problems if the procedure name is sendMail as that method already exists in Excel. For this example, I've used the name sendEmails.

Sub sendEmails()
On Error GoTo Error_Handler
    Dim OApp As Object
    Dim OMail As Object
    Dim WApp As Object
    Dim WDoc As Object
    Dim strTempFile As String
    Dim strWDocPath As String
    Dim row As Long
    Dim col As Long
    
    ' Replace FULL_PATH_NAME with the full name, including the path, of the Word document
    ' to use as a template, e.g. C:\Users\Sam\Documents\SalaryConfirmation.docx.
    ' The template can contain placeholders, e.g. <name>, which will be matched
    ' with the corresponding field names in the Excel worksheet.
    strWDocPath = "FULL_PATH_NAME"
    
    ' Check cell B1 = <mail>
    If [B1] <> "<mail>" Then
        MsgBox "Expected value ""<mail>"" in cell B1", vbCritical, "Failed"
        Exit Sub
    ' Check there is mail to send
    ElseIf Cells(Rows.Count, 2).End(xlUp).row = 1 Then
        MsgBox "No mail to send", vbInformation, "Exit"
        Exit Sub
    ' Check Word document path
    ElseIf strWDocPath = "" Or Dir(strWDocPath) = "" Then
        MsgBox "Word document not found: """ & strWDocPath & """", vbCritical, "Failed"
        Exit Sub
    End If

    Set OApp = CreateObject("Outlook.Application")
    Set WApp = CreateObject("Word.Application")
    
    For row = 2 To Cells(Rows.Count, 2).End(xlUp).row
        ' Create Word document from template
        Set WDoc = WApp.Documents.Add(strWDocPath)
        
        ' Replace field placeholders in Word document with values from respective fields in Excel
        For col = 3 To [A1].End(xlToRight).Column
            If Left(Cells(1, col), 1) = "<" And Right(Cells(1, col), 1) = ">" Then
                WDoc.Content.Find.Execute _
                    FindText:=Cells(1, col), ReplaceWith:=Cells(row, col), Replace:=2
            End If
        Next
        
        ' Save Word document in Temp folder
        strTempFile = Environ("Temp") & "\SalaryConfirmation.docx"
        WDoc.SaveAs2 strTempFile
        WDoc.Close 0
        
        ' Create email and attach Word document
        Set OMail = OApp.CreateItem(0)
        With OMail
            .To = Cells(row, 2)
            .Subject = "Salary confirmation"
            .Attachments.Add strTempFile
        End With
        
        ' Send email
        OMail.Send
    Next
    
    ' Clean up
    WApp.Quit 0
    ChDir Environ("Temp")
    Kill Dir(strTempFile)

Error_Exit:
    Exit Sub
Error_Handler:
    If Not OApp Is Nothing Then
        If Not OMail Is Nothing Then
            OMail.Close 1
        End If
    End If
    
    If Not WApp Is Nothing Then
        WApp.Quit 0
    End If
    
    MsgBox Err.Number & ": " & Err.Description, vbCritical, "Error"
    Resume Error_Exit
End Sub