文章/答案/技术大牛

发布

社区首页 >问答首页 >使用Excel实现邮件合并自动化

问使用Excel实现邮件合并自动化
EN

Stack Overflow用户

提问于 2015-02-18 13:48:09

回答 2查看 39.9K关注 0票数 3

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

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

我已自动运行邮件合并，并按员工姓名保存个人文件。而且每次它为一个人运行文件时，它都会给出已经生成的字母的状态，这样它就不会复制任何员工记录。

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

我的行有以下数据：

A行:有S.No。行B:有空名行C:有处理日期 D行:有地址 E行: Firstname 第F行:企业名称第G行:显示状态(如果生成该字母，则在运行宏后显示“已生成的字母”，如果输入的是新记录，则显示为空白。

另外，如何将输出(合并文件)也保存在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

excel

vba

merge

ms-word

回答 2

Stack Overflow用户

发布于 2015-02-18 15:37:45

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

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

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

相反，您希望一次只执行一个合并字母。

若要解决此问题，请按以下方式更改行：

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

希望这能有所帮助。

票数 5

Stack Overflow用户

发布于 2022-04-14 19:23:20

以下代码按预期工作。它为数据表中的每个条目保存一个.docx和一个.pdf文件，同时遵循Opies老爸的建议。

在运行之前，检查是否激活了用于Word的VBA库(Microsoft 16.0对象库)，并从Word模板(邮件合并设置)连接到Excel数据表。

Sub MergeMe()

Application.ScreenUpdating = False

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("Dados").Range("A" & Rows.Count).End(xlUp).Row
r = 2

' Setup filenames
Const WTempName = "Proposta.docx" 'Word Template name,  Change as req'd
Dim NewFileName As String

On Error Resume Next

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

' 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"
Exit Sub
End If

' 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)

'loop through each table row
For r = 2 To lastrow

    If Cells(r, 7).Value = "Letter Generated Already" Then GoTo nextrow
    
    objMMMD.Activate
    
    'Merge the data
    With objMMMD
    
    .MailMerge.OpenDataSource Name:=cDir + ThisFileName, sqlstatement:="SELECT *  FROM `Dados$`"   ' Set this as required
    
        With objMMMD.MailMerge  'With ActiveDocument.MailMerge
        
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            
                With .DataSource
                    .FirstRecord = r - 1
                    .LastRecord = r - 1
                    .ActiveRecord = r - 1

                     EmployeeName = .DataFields("Nome").Value 'Change "Nome". to the column name for employee names"
                     
                End With
               
            .Execute Pause:=False 'executes the mail merge
        End With
        
    End With
    
On Error GoTo 0

' Save new file (.docx & .pdf) and close it
NewFileName = "Offer Letter - " & EmployeeName  'Word Document File Name, Change as req'd"
objWord.ActiveDocument.SaveAs cDir + NewFileName + ".docx"

objWord.ActiveDocument.ExportAsFixedFormat cDir + NewFileName + ".pdf", _
                  ExportFormat:=wdExportFormatPDF

objWord.ActiveDocument.Close

Cells(r, 7).Value = "Letter Generated Already"

nextrow:
Next r

objMMMD.Close False
objWord.Quit

Application.ScreenUpdating = True

End Sub

票数 0

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/28585226

复制

相似问题

问使用Excel实现邮件合并自动化
EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问使用Excel实现邮件合并自动化EN

回答 2

Stack Overflow用户

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问使用Excel实现邮件合并自动化
EN