Question

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

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

我已自动运行邮件合并，并根据员工姓名保存单个文件。每次为一个人运行文件时，它都会将状态设置为Letter Already Generate，以便它不会复制任何Employee记录。

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

我的行包含以下数据：

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

另外如何将输出（合并文件）也保存在DOC文件以外的PDF文件中，这样合并后的文件将采用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

Answer 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。

您不需要每次都打开单词，因此请将所有代码设置为邮件合并的数据源，并在主循环之外创建单词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文件中的Employee名称以创建文件名。对我来说，将文件名链接到刚刚合并的字母更为直观。为此，请将该行更新为：

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

希望这有帮助。

使用Excel VBA自动化邮件合并

1 个答案: