使用 Excel VBA 自动合并邮件 [英] Automating Mail Merge using Excel VBA

问题描述

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

I created a macro in Excel where I can mail-merge data from Excel into Word Letter Template and save the individual files in the folder.

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

I have Employee data in Excel and I can generate any Employee letter using that Data and can save the individual Employee letter as per the Employee name.

我已经自动运行邮件合并并按照员工姓名保存单个文件.并且每次为一个人运行该文件时，它都会将状态设置为 Letter Already Generate，这样它就不会复制任何员工记录.

I have run mail-merge automatically and save individual files as per the Employee name. And every time it runs the file for one person it will give the status as Letter Already Generate so that it wont duplicate any Employee records.

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

The problem is the output in all the merged files the output is same as the first row. Example: if my Excel has 5 Employee details I am able to save the 5 individual merged files on each employee name, however the merged data if of the first employee who is in Row 2.

我的行有以下数据:

A 行:有 S.No.
B行:有员工姓名
C 行:有处理日期
D行:有地址
E 行:名字
F 行:企业名称
G行:显示状态(如果有字母生成则运行宏后显示Letter Generated Already"，如果是新记录则显示空白.

Row A: has S.No.
Row B: has Empl Name
Row C: has Processing Date
Row D: has Address
Row E: Firstname
Row F: Business Title
Row G: Shows the status (if the letter is generated it shows "Letter Generated Already" after running the macro or it shows blank if it is new record entered.

另外，我如何将输出(合并文件)也保存在 DOC 文件以外的 PDF 中，以便合并后的文件有两种格式，一种是 DOC，另一种是 PDF 格式?

Also how can I save the output (merged file) also in PDF other than DOC file so the merged files will be in two formats one in DOC and the other one in PDF formats?

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

推荐答案

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

To save the file in pdf format use

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

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

It looks to me that when you are executing the mail merge, it should create a file with ALL of the letters, so when you open it, it would appear that the first letter is the one that is getting saved, but if you scroll down the word file that you have saved, you may find each letter on a new page.

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

Instead, you want to execute the merge one letter at a time.
To fix this, change the lines as follows:

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

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

You need to use r-1 because Word is going to use the record number in its dataset, and since the data starts in row 2, and the counter r is related to the row, you need r-1.

您不需要每次都打开 word，因此将所有设置邮件合并数据源和创建 word doc 的代码放在主循环之外.

You don't need to open up word each time, so put all of the code setting the datasource of the mail merge and creating the word doc outside of your main loop.

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 文件以创建文件名.对我来说，将文件名链接到刚刚合并的字母会更直观一些.为此，将该行进一步更新为:

Also, instead of checking the Excel file for the Employee name to create the file name, you could do this after you merge the document. For me, this is a little more intuitive to link the file name to the letter you have just merged. To do this update the line further to:

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

然后在保存文件之前，您可以立即执行以下操作:

Then immediately before saving the file you can do this:

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

希望这会有所帮助.

这篇关于使用 Excel VBA 自动合并邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！