Word VBA一键实现 邮件合并自动加载Excel数据,合并完后自动保存

dyt2020

由于要在MS word 2003中大量的数据要进行邮件合并操作,实际是每次要浏览Excel数据库的位置,比较麻烦,在合并完后又要选择保存的位置,现在写一个VBA宏程序,实现:
1.运行第一个宏,实现自动加载指定位置的Excel数据源(这个指定位置的Excel数据源的名字要从一个文件中读取)
2.运行第二个宏,实现进行邮件合并,并把合并后的Word文档自动保存到指定位置并关闭, Word文档自动保存的名字,就是第一个宏加载的Excel数据源的名字(或者是Excel数据源中某一个单元格的数据)

[ 本帖最后由 dyt2020 于 2011-6-12 14:54 编辑 ]

dyt2020

条件:从当前用户桌面的Excel表获取数据源,Excel表数据源的名字从用户D盘的1.xls Sheet1!A1获取
运行第一个宏加载数据库必须先打开一个Excel表,否则会出错
运行第二个宏合并1-6条记录至桌面,并关闭
由于第一次写这种东东 好多地方还要优化,稍候在附上,后面将将实现一键实现从数据加载到合并至指定位置,简化大家的工作量
第一个宏编写:
Sub 加载数据库()
'
' 加载数据库 Macro
' 宏在 2011-6-11 由 雨林木风 录制
'
      chan = DDEInitiate(app:="Excel", topic:="system") '打开一个DDE通道
      DDEExecute channel:=chan, Command:="[open(" & Chr(34) & "D:\1.xls" & Chr(34) & ")]"  '在一个应用程序中执行打开.xls文件命令，需要指出的是，系统要求所需文件必须放在D盘。
      DDETerminate channel:=chan   '关闭DDE通道
      chan = DDEInitiate(app:="Excel", topic:="D:\1.xls")     '打开一个DDE通道
      Dim s As String
      Dim q As String
      Dim y As String
      s = DDERequest(channel:=chan, Item:="R1C1")
      DDETerminateAll
      Dim excelClose As Object
      Set excelClose = GetObject(, "Excel.Application")
      excelClose.workbooks("1.xls").Close False
      y = Left(s, Len(s) - 1)
      q = "C:\Documents and Settings\" & Environ("USERNAME") & "\桌面\" & y & ".xls"

    ActiveDocument.MailMerge.OpenDataSource Name:=q, _
        ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=q;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Data" _
        , SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
End Sub

第二个宏已经变相的实现:多谢这个帖子:http://club.excelhome.net/thread-729315-1-1.html
下面是代码:

Sub 保存至桌面()
'主文档的类型为信函
'合并全部数据记录
'假设主文档已链接好数据源，可以进行正常的邮件合并
Dim myMerge As MailMerge, i As Integer, myname As String
Application.ScreenUpdating = False
Set myMerge = ActiveDocument.MailMerge
With myMerge.DataSource
    If .Parent.State = wdMainAndDataSource Then
        .ActiveRecord = wdFirstRecord
   
            .FirstRecord = 1
            .LastRecord = 6
            .Parent.Destination = wdSendToNewDocument
            '取得数据源第1个和第2个字段（合并域）的当前数据字符串，用以命名文件，根据需要增减修改
            myname = .DataFields(9).Value & " （" & .DataFields(35).Value & "Km" & "）"
            .ActiveRecord = wdNextRecord
            .Parent.Execute  '每次合并一个数据记录
            With ActiveDocument
                .Content.Characters.Last.Previous.Delete  '删除分节符
                .SaveAs "C:\Documents and Settings\" & Environ("USERNAME") & "\桌面\" & myname & ".doc"  '假设生成的各文档保存于c盘桌面
                .Close  '关闭生成的文档（已保存）
            End With
            
    End If
  End With
End Sub

[ 本帖最后由 dyt2020 于 2011-6-12 16:20 编辑 ]

dyt2020

55555555555555555

[ 本帖最后由 dyt2020 于 2011-6-12 17:44 编辑 ]

realmilk

保存下来，好好研究一下

闻启学

realmilk 发表于 2012-6-18 23:13
保存下来，好好研究一下

楼主  请问什么意思   这个几个代码    能否指导下 我刚刚玩word VBA
s = DDERequest(channel:=chan, Item:="R1C1")

      y = Left(s, Len(s) - 1)
      q = "C:\Documents and Settings\" & Environ("USERNAME") & "\桌面\" & y & ".xls"

surferhw

恰好需要,好好研究下,

tpriyeah

邮件合并功能，不错不错，支持学习

xia355

这个很有用哦！

zhanglei1371

闻启学 发表于 2013-2-21 15:46
楼主  请问什么意思   这个几个代码    能否指导下 我刚刚玩word VBA
s = DDERequest(channel:=chan, It ...

word2003中的帮助：

1. DDEInitiate 方法
   
2. 参阅应用于示例特性打开通向其他应用程序的 DDE（动态数据交换）通道，并返回通道序号。
   
3. 
   
4. 
   
5. 安全性  动态数据交换 (DDE) 是一种不安全的陈旧技术。如果可能，请使用比 DDE 更加安全的技术，如对象链接与嵌入 (OLE)。
   
6. 
   
7. 
   
8. expression.DDEInitiate(App, Topic)
   
9. expression      可选。该表达式返回一个 Application 对象。
   
10. 
    
11. App      String 类型，必需。应用程序名。
    
12. 
    
13. Topic      String 类型，必需。DDE 主题名称（比如某一打开文档的名称），通道所指向的应用程序将识别该名称。
    
14. 
    
15. 说明
    
16. 如果成功，DDEInitiate 方法将返回打开通道的序号。所有后续的 DDE 函数通过该序号来识别本通道。
    
17. 
    
18. 示例
    
19. 本示例用 System 主题创建 DDE 会话，并打开 Microsoft Excel 工作表 Sales.xls。然后本示例终止 DDE 通道，创建通向 Sales.xls 的通道，并在 R1C1 单元格中插入文本。
    
20. 
    
21. Dim lngChannel As Long
    
22. 
    
23. lngChannel = DDEInitiate(App:="Excel", Topic:="System")
    
24. DDEExecute Channel:=lngChannel, Command:="[OPEN(" & Chr(34) _
    
25.     & "C:\Sales.xls" & Chr(34) & ")]
    
26. DDETerminate Channel:=lngChannel
    
27. lngChannel = DDEInitiate(App:="Excel", Topic:="Sales.xls")
    
28. DDEPoke Channel:=lngChannel, Item:="R1C1", Data:="1996 Sales"
    
29. DDETerminate Channel:=lngChannel
    
30.                
    

复制代码

至于Environ("USERNAME") ，是当前用户的环境变量。一般是管理员：Administrator

gaozengxun

研究研究。