邮件合并中如何能直接找到工作簿中的对应数据表？

陈王宇翔

比如我有两张word需要对应一个工作簿的两张表，如何能每次打开word时省去选择的一步呢？像附件里的收入封面直接能找到工作簿中的收入附注表，费用封面直接到到费用附注表？

里面有个代码，不知道怎么再优化一下


Desktop.rar (52.38 KB, 下载次数: 8)

2024-1-26 20:36 上传

点击文件名下载附件

Sub AutoOpen()
'
' Auto_Open宏 该宏设为主文档打开时自动运行，自动取得与邮件合并主文档同一目录下
' Excel数据源的绝对路径，并载名Excel入数据源到主文档。需要说明的是文件打开时会
'提示“数据库中的数据将被放置到文档中，是否继续？”时，应选否。
'本宏仅适合于名Excel数据源在第一个工作表的工作簿,且其中的工作表只能叫“数据源”
'
Dim p As String
Dim p1 As String

p1 = Documents(ActiveDocument.Name).Path '取得WORD文档的绝对路径

Dim qgrmdtj()
   myPath = p1         '把文件路径定义给变量
   n = 1
   myFile = Dir(myPath & "\高新研发费用审计通用底稿.xls") '获取excel文件名
    If myFile = "" Then
      myFile = Dir(myPath & "\高新研发费用审计通用底稿.xlsx") '当没有xls文件时，改查xlsx文件，获取excel文件名
   Else
     End If


p = p1 & "\" & myFile ''计算出名Excel数据源绝对路径
MsgBox ("请选择对应的工作表！") '弹出提示
        ActiveDocument.MailMerge.OpenDataSource Name:= _
        p, ConfirmConversions:=False, _
         ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
        Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=p;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Loc" _
''加载excel文件，并提示选择工作表
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle '点击预览结果按钮
End Sub

陈王宇翔

自己顶一下

陈王宇翔

比较难解决