带Word文档附件的VBA Macro电子邮件

如何解决带Word文档附件的VBA Macro电子邮件

我正在学习Excel VBA，我想将excel中的数据替换为word文档，并通过每行相应的电子邮件将其发送给工作人员。目前，我已经通过电子邮件发送了邮件，但是我不知道如何最好地附加Word文档，我有数百名员工。 谢谢你所做的一切。

main.py

解决方法

如果我了解您的要求，则以下代码可能会有所帮助。请注意，如果过程名称为sendMail，则可能会遇到问题，因为该方法已经存在于Excel中。在此示例中，我使用了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 & """","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,1) = ">" Then
                WDoc.Content.Find.Execute _
                    FindText:=Cells(1,ReplaceWith:=Cells(row,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,"Error"
    Resume Error_Exit
End Sub