用VBA代码实现邮件合并的功能

dragonthree

用VBA代码实现邮件合并的功能,详见附件

dragonthree

下了，明天再来看，望高手出招，谢谢！

dragonthree

这个问题没人能会吗？

白月清风

以下是我做的自动邮件合并代码2011.09.28当时也是想实现办公自动化，让不懂邮件合并的打印工资条，楼主可以根据自己需要修改代码
本代码执行，需要word文档中有至少一个2行的表格，出现错误的代码省略了
Sub 邮件合并()
   Application.ScreenUpdating = False '屏幕刷新关闭
    If ActiveDocument.MailMerge.DataSource.Name <> "" Then ActiveDocument.MailMerge.DataSource.Close '关闭文件原数据源

   Dim myfile As FileDialog
    Set myfile = Application.FileDialog(msoFileDialogFilePicker)
    With myfile
        .InitialFileName = "*.xl*"
         .AllowMultiSelect = False   ' 只允许选取一个文件
    If .Show = -1 Then
      myfilepath = .SelectedItems(1)
      
          ActiveDocument.MailMerge.OpenDataSource Name:=myfilepath '执行邮件合并
     
             a = ActiveDocument.MailMerge.DataSource.FieldNames.Count '域的个数
             b = ActiveDocument.Tables.Count '表格的个数
            
            For j = 1 To b
            
             ActiveDocument.Tables(j).Range.Delete '清空表格
            
            For i = 1 To a
            
             ActiveDocument.Tables(j).Cell(1, i).Range = ActiveDocument.MailMerge.DataSource.FieldNames(i).Name '在表格第1行插入域名
            ActiveDocument.MailMerge.Fields.Add Range:=ActiveDocument.Tables(j).Cell(2, i).Range, Name:=ActiveDocument.MailMerge.DataSource.FieldNames(i).Name '在表格第二行插入域
            Next i
            Next j
            
   
   '合并到新文档
          With ActiveDocument.MailMerge
            .Destination = wdSendToNewDocument '合并到文档
            .SuppressBlankLines = True
           With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
           End With
             .Execute Pause:=False
          End With
      
    Else
  
        Exit Sub
    End If
   End With
   
Application.ScreenUpdating = True '屏幕刷新关闭

End Sub

dragonthree

谢谢，我试一下！

xsy我可以很好

不明白为什么非要邮件合并：
1.邮件合并唯一可以批量打印，多少excel同样可以实现
2.邮件合并后的文档很大，不方便管理
3.最头痛的是维护


所有建议不用邮件合并

tpriyeah

学习下，借鉴一下，正想进行这个功能

renkangjizhen

感谢分享！受教了