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

问题描述

我的名字是Hema，这是我的第一个宏，并且是Stack堆栈中的第一个。

我已经在Excel中创建了一个宏，我可以通过邮件合并数据Excel会自动将Word文本模板自动保存到文件夹中。

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

我已经成功地自动运行邮件合并，并按照员工名称保存单个文件。并且每次为一个人运行文件时，它将给出已经生成的字母的状态，以便它不会重复任何员工记录。

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

我无法附加文件，但我的行具有以下数据：
行A ：有S.No.
行B：有Empl名称
行C：有处理日期
行D：有地址
行E：名字
行F：业务标题
行G：显示状态（如果生成该字母，则在运行宏后显示已生成字母，如果输入新记录，则显示为空白。

另外请求某人添加一个代码，我可以在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 
对于r = 2 To lastrow 
如果Cells（r，7）.Value =Lette r生成已经然后GoTo nextrow 
 EmployeeName = Sheets（Data）。Cells（r，2）.Value 
 
'安装文件名
 Const WTempName =letter.docx '这是07/10 Word模板名称，更改为req'd 
 Dim NewFileName As String 
 NewFileName =Offer Letter  - & EmployeeName& .docx'这是新的07/10 Word文档文件名，更改为req'd
 
'安装目录
 cDir = ActiveWorkbook.path +\'更改如果合适
 ThisFileName = ThisWorkbook.Name 
 
错误恢复下一步
 
'创建一个Word应用程序实例
 bCreatedWordInstance = False 
设置objWord = GetObject（，Word.Application）
 
如果objWord是Nothing然后
 Err.Clear 
设置objWord = CreateObject（Word.Application）
 bCreatedWordInstance = True 
如果
 
如果objWord是Nothing然后
 MsgBox无法启动Word
 Err.Clear 
错误GoTo 0 
 Exit Sub 
 End If 
 
'让Word陷阱错误
 On Error GoTo 0 
 
'如果要查看Word，请设置为True在建设过程中的文件闪存
 objWord.Visible = False 
 
'打开Word模板
设置objMMMD = objWord.Documents.Open（cDir + WTempName）
 objMMMD.Activate 
 
'合并数据
与objMMMD 
 .MailMerge.OpenDataSource名称：= cDir + ThisFileName，sqlstatement：=SELECT * FROM`Data $`'设置为必需
 
 With objMMMD.MailMerge'使用ActiveDocument.MailMerge 
 .Destination = wdSendToNewDocument 
 .SuppressBlankLines = True 
 With .DataSource 
 .FirstRecord = wdDefaultFirstRecord 
 .LastRecord = wdDefaultLastRecord 
 End With 
 .Execute暂停：= False 
结束
结束
 
'保存新文件
 objWord.ActiveDocument.SaveAs cDir + NewFileName 
 
'关闭邮件合并主文档
 objMMMD.Close savechanges：= wdDoNotSaveChanges 
设置objMMMD =没有
 
'关闭新邮件合并文档
如果bCreatedWordInstance然后
 objWord.Quit 
 End If 
 
 0：
设置objWord = Nothing 
单元格（r，7）.Value =生成的字母已经 
 nextrow：
 
下一个r 
 End Sub 
  

问候，
Hema

解决方案

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

  objWord.ActiveDocument.ExportAsFixedFormat cDir& NewFileName，_ 
 ExportFormat：= wdExportFormatPDF 
  

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

相反，您要一次执行合并一个字母。

要解决此问题，请更改行如下：

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

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

您不需要每次打开字词，所以把所有的代码设置为邮件的数据源合并并在主循环外创建文字。

  Const WTempName =letter.docx'This是07/10 Word模板名称，
 Dim NewFileName As String 
 
'安装目录
 cDir = ActiveWorkbook.path +\'如果合适，更改
 ThisFileName = ThisWorkbook.Name 
 
错误恢复下一步
 
'创建一个Word应用程序实例
 bCreatedWordInstance = False 
设置objWord = GetObject（，Word .Application）
 
如果objWord是Nothing然后
 Err.Clear 
设置objWord = CreateObject（Word.Application）
 bCreatedWordInstance = True 
如果
 
如果objWord是Nothing然后
 MsgBox无法启动Word
 Err.Clear 
错误GoTo 0 
退出Sub 
结束如果
 
'让Word陷阱错误
错误GoTo 0 
 
'如果要在构建期间看到Word文件闪存过去，设置为True b $ b objWord.Visible = False 
 
'打开Word模板
设置objMMMD = objWord.Documents.Open（cDir + WTempName）
 objMMMD.Activate 
 
'合并数据
使用objMMMD 
 .MailMerge.OpenDataSource名称：= cDir + ThisFileName，_ 
 sqlstatement：=SELECT * FROM`Data $`'将其设置为必需
 
对于r = 2 To lastrow 
如果单元格（r，7）.Value =生成的字母已经然后GoTo nextrow 
'剩余的代码到这里
 另外，您可以在合并文档之后执行此操作，而不是检查用于创建文件名的员工名称的Excel文件。对于我来说，将文件名与您刚刚合并的文字相关联，这更直观。为此，请进一步更新：
 使用.DataSource 
 .FirstRecord = r-1 
 .LastRecord = r-1 
 .ActiveRecord = r-1 
 EmployeeName = .EmployeeName'假设这是字段名称
  
然后在保存文件之前立即执行此操作：
 '保存新文件
 NewFileName =提供信 - & EmployeeName& .docx
 objWord.ActiveDocument.SaveAs cDir + NewFileName 
  
希望这有帮助。 / p> 
My Name is Hema and this is my First Macro and first post in Stack overflow.

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

I have a 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.

I have been successful to 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.

Now the only problem I am facing 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 only. In all the files the data is showing for the first row employee.

I couldn't attached the files but my rows have the below data:
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.

Also request someone to add a code where I can 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.

Thank you very much in Advance hope to listen from someone shortly.
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
Regards,
Hema
解决方案
To save the file in pdf format use  
objWord.ActiveDocument.ExportAsFixedFormat cDir & NewFileName, _
                  ExportFormat:=wdExportFormatPDF
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
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.

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
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
Hope this helps.

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