使用 Excel VBA 自动合并邮件

Posted 2023-02-23

【中文标题】使用 Excel VBA 自动合并邮件

【英文标题】：Automating Mail Merge using Excel VBA

【发布时间】：2015-04-19 13:11:00

【问题描述】：

我在 Excel 中创建了一个宏，我可以在其中将 Excel 中的数据通过邮件合并到 Word 信函模板中，并将各个文件保存在文件夹中。

我在 Excel 中有员工数据，我可以使用该数据生成任何员工信函，并可以根据员工姓名保存单个员工信函。

我已自动运行邮件合并并根据员工姓名保存单个文件。每次它为一个人运行文件时，它都会将状态显示为 Letter Already Generate，这样它就不会重复任何员工记录。

问题是所有合并文件中的输出与第一行相同。示例：如果我的 Excel 有 5 个员工详细信息，我可以在每个员工姓名上保存 5 个单独的合并文件，但是如果是第 2 行中的第一个员工，则合并数据。

我的行有以下数据：

A 行：有 S.No. B 行：具有 Empl 名称 C 行：有处理日期 D 行：有地址 E 行：名字 F 行：业务名称 G行：显示状态（如果生成了字母，则在运行宏后显示“Letter Generated Already”，如果输入新记录，则显示空白。

此外，我如何将输出（合并文件）也保存为 PDF 文件而不是 DOC 文件，以便合并的文件有两种格式，一种是 DOC 格式，另一种是 PDF 格式？

Sub MergeMe()

Dim bCreatedWordInstance As Boolean
Dim objWord As Word.Application
Dim objMMMD As Word.Document
Dim EmployeeName As String
Dim cDir As String
Dim r As Long
Dim ThisFileName As String
lastrow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
r = 2
For r = 2 To lastrow
If Cells(r, 7).Value = "Letter Generated Already" Then GoTo nextrow
EmployeeName = Sheets("Data").Cells(r, 2).Value

' Setup filenames
Const WTempName = "letter.docx" 'This is the 07/10 Word Templates name,  Change as req'd
Dim NewFileName As String
NewFileName = "Offer Letter - " & EmployeeName & ".docx" 'This is the New 07/10 Word Documents File Name, Change as req'd"

' Setup directories
cDir = ActiveWorkbook.path + "\" 'Change if appropriate
ThisFileName = ThisWorkbook.Name

On Error Resume Next

' Create a Word Application instance
bCreatedWordInstance = False
Set objWord = GetObject(, "Word.Application")

If objWord Is Nothing Then
  Err.Clear
  Set objWord = CreateObject("Word.Application")
  bCreatedWordInstance = True
End If

If objWord Is Nothing Then
MsgBox "Could not start Word"
Err.Clear
On Error GoTo 0
Exit Sub
End If

' Let Word trap the errors
On Error GoTo 0

' Set to True if you want to see the Word Doc flash past during construction
objWord.Visible = False

'Open Word Template
Set objMMMD = objWord.Documents.Open(cDir + WTempName)
objMMMD.Activate

'Merge the data
With objMMMD
.MailMerge.OpenDataSource Name:=cDir + ThisFileName, sqlstatement:="SELECT *  FROM `Data$`"   ' Set this as required

With objMMMD.MailMerge  'With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
  .FirstRecord = wdDefaultFirstRecord
  .LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
End With

' Save new file
objWord.ActiveDocument.SaveAs cDir + NewFileName

' Close the Mail Merge Main Document
objMMMD.Close savechanges:=wdDoNotSaveChanges
Set objMMMD = Nothing

' Close the New Mail Merged Document
If bCreatedWordInstance Then
objWord.Quit
End If

0:
Set objWord = Nothing
Cells(r, 7).Value = "Letter Generated Already"
nextrow:

Next r

End Sub

【参考方案1】：

要将文件保存为 pdf 格式，请使用

objWord.ActiveDocument.ExportAsFixedFormat cDir & NewFileName, _
                  ExportFormat:=wdExportFormatPDF

在我看来，当您执行邮件合并时，它应该创建一个包含所有字母的文件，因此当您打开它时，看起来第一个字母是正在保存的字母，但如果向下滚动保存的 word 文件，您可能会在新页面上找到每个字母。

相反，您希望一次执行一个字母的合并。 要解决此问题，请按如下方式更改行：

With .DataSource
  .FirstRecord = r-1
  .LastRecord = r-1
  .ActiveRecord = r-1

您需要使用r-1，因为Word 将使用其数据集中的记录号，并且由于数据从第2 行开始，并且计数器r 与该行相关，因此您需要r-1。

你不需要每次都打开word，所以把设置邮件合并的数据源和创建word doc的所有代码放在你的主循环之外。

Const WTempName = "letter.docx" 'This is the 07/10 Word Templates name,  
Dim NewFileName As String

' Setup directories
cDir = ActiveWorkbook.path + "\" 'Change if appropriate
ThisFileName = ThisWorkbook.Name

On Error Resume Next

' Create a Word Application instance
bCreatedWordInstance = False
Set objWord = GetObject(, "Word.Application")

If objWord Is Nothing Then
  Err.Clear
  Set objWord = CreateObject("Word.Application")
  bCreatedWordInstance = True
End If

If objWord Is Nothing Then
    MsgBox "Could not start Word"
    Err.Clear
    On Error GoTo 0
    Exit Sub
End If

' Let Word trap the errors
On Error GoTo 0

' Set to True if you want to see the Word Doc flash past during construction
objWord.Visible = False

'Open Word Template
Set objMMMD = objWord.Documents.Open(cDir + WTempName)
objMMMD.Activate

'Merge the data
With objMMMD
.MailMerge.OpenDataSource Name:=cDir + ThisFileName, _
    sqlstatement:="SELECT *  FROM `Data$`"   ' Set this as required

For r = 2 To lastrow
    If Cells(r, 7).Value = "Letter Generated Already" Then GoTo nextrow
'rest of code goes here

此外，您可以在合并文档后执行此操作，而不是检查 Excel 文件中的员工姓名来创建文件名。对我来说，将文件名链接到刚刚合并的字母更直观一些。为此，请将该行进一步更新为：

With .DataSource
  .FirstRecord = r-1
  .LastRecord = r-1
  .ActiveRecord = r-1
  EmployeeName = .EmployeeName 'Assuming this is the field name

然后在保存文件之前你可以这样做：

 ' Save new file
NewFileName = "Offer Letter - " & EmployeeName & ".docx"
objWord.ActiveDocument.SaveAs cDir + NewFileName

希望这会有所帮助。

【讨论】：

感谢您的回答，执行后我了解到我可以在一个文件中执行邮件合并，但我的要求是为每个员工生成单独的信件。由于我必须向 500 多名员工提供个人信件，因此当我将数据输入到我的 excel 数据文件并运行宏按钮时需要更新宏，所有邮件合并的数据都将自动保存为个人员工的 PDF 和文档，例如如果我为 500 名员工运行宏，我应该将 500 个单独的文件仅与他们的数据合并并用他们各自的名称保存。请帮忙

盒马，我提供的答案解决了您的问题。请仔细阅读。

亲爱的 OpiesDad 我很抱歉，正如你所说，是的，这段代码对我来说很好用，唯一的问题是“EmployeeName = .EmployeeName '假设这是字段名称”显示错误我无法保存文件每个人的名字。请指教。

您需要将列名放在 excel 文件中。因此，如果在“数据”表中，员工姓名的列标题是“EmpName”，那么该行需要是：“EmployeeName = .EmpName”

我的列标题是 EmployeeName，因此添加了该行，因为它是“EmployeeName = .EmployeeName”，但仍然出现错误“Complie Error: syntax error”并突出显示该行。我知道我在这个问题上打扰你，但严重需要你的帮助。非常感谢你。 :-)