Excel VBA 邮件合并

一、问题的提出：要将EXCEL中一行数据写到word文档中，形成不同的WORD文档。如学生入学通知书。
二、思路：主要依靠word中的邮件合并功能，数据来源于EXCEL表格。
三、我自已用vba 编写了一个 将EXCEL表中的数据做为数据源，利用word中的邮件合并，生成一个WORD文档
使用时可调用这个函数：
Function scwd(scwjm)
On Error Resume Next
    '下面这句话运行的话，必须有前面的 On Error Resume Next 这句话，因为如果没有这句话 Set objWD....这句话时，当没有打开的
    'word程序会报错，程序会停止运行，有了这句话，不会停止，正常运行
'    Dim objWD As Object
'    Set objWD = GetObject(, 'WOrd.Application')
'    If Not objWD Is Nothing Then
'    '    objWD.Activate
'        ms = MsgBox('有word文档正在打开着，是否关闭?', vbYesNo, 'WORD关闭提示！') 'objWD
'        If ms = 6 Then
'          objWD.Quit
'        Else
'          Exit Function
'
'        End If
'    End If
'以上这一段是检测是否有WORD文档打开，如果有，提示可以关闭WORD程序，继续生成，否则不提示也不生成了
'2012年1月10日试验成功！
'
'
'Set wordobject = Nothing
Sheets('模板').Select      '
Range('a1').CurrentRegion.Select      '选中非空部分
Selection.CurrentRegion.Select
Selection.EntireColumn.AutoFit '列适中  如果不显示出来，不行
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
'On Error Resume Next
Selection.Copy  '从EXCEL表中拷备到WORD中
'将内容复制到“数据源1.doc'word文档中
Dim wordobject As Object
Set wordobject = CreateObject('word.application') '起动WORD
wordobject.Visible = True  ‘可见

wordobject.Documents.Open FileName:= _
   ThisWorkbook.Path & '\模板\数据源.doc'  '打开邮件合并用所链接的数据源文件
   
'On Error Resume Next
wordobject.Selection.Tables(1).Select '先中原有表格


wordobject.Selection.Tables(1).Delete '清除表格
Set my = wordobject.ActiveDocument.Range(0, 0) '定位到文档首位
my.PasteSpecial '粘贴刚才从EXCEL粘过来的内容
wordobject.ActiveDocument.Close '关闭文件
Application.CutCopyMode = False '将前切板内容清空
        '打开文件
        xmcd = InStr(scwjm, '_') '姓名的长度
        Dim mbmc As String
        mbmca = Mid(scwjm, xmcd + 1, 50) '模板名称
        ss = InStr(mbmca, '模板')
        mbmc = Mid(mbmca, 1, ss - 1)
        xm = Mid(scwjm, 1, xmcd) '取出姓名
        wordobject.Documents.Open FileName:= _
          ThisWorkbook.Path & '\模板\' & mbmc & '模板.doc'
        '邮件合并
        wordobject.ActiveDocument.MailMerge.OpenDataSource Name:= _
        ThisWorkbook.Path & '\模板\数据源.doc'    '这句是wordr的邮件合并关键语句
        wordobject.ActiveDocument.MailMerge.Execute Pause:=True   '这句是wordr的邮件合并关键语句
        '存盘
         Dim csbwjm As String '需人保存的文件名
'         csbwjm = Year(Date) & '年' & IIf(Month(Date) < 10, '0' & Month(Date), Month(Date)) & '月' & Day(Date) & '日' & Hour(Time) & '时' & Minute(Time) & '分' & xm & '' & Mid(mbmc, 1, 20)
         csbwjm = xm & '' & Mid(mbmc, 1, 20)
         
         wordobject.ActiveDocument.SaveAs FileName:= _
           ThisWorkbook.Path & '\生成文档\' & csbwjm & '.doc', FileFormat:= _
           wdFormatDocument, LockComments:=False, Password:='', AddToRecentFiles:= _
            True, WritePassword:='', ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
            False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
            SaveAsAOCELetter:=False
'            wordobject.Windows(mbmc & '模板.doc' & '.doc').Activate
            wordobject.Windows(mbmc & '模板.doc').Activate
            
            wordobject.ActiveDocument.Close
            
            wordobject.Visible = True

Set wordobject = Nothing
            '
End Function
运用此函数过程是：手工做一个数据源的word表格，再用wordr 的邮件合并功能将数据源文件链接起来，把数据项写到word中。保存这个文件做为模板，运用上面的程序可自动生成你需要的word文档了。如需要可以详细说明