邮件合并，相对路径的一些问题

weer2

office2016邮件合并为了满足相对路径的要求用了网站大神的VBA代码，本来是可以用的，最近突然出现了问题，不知道哪个大神再给看看代码如下：

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

weer2

在线等大神回复，学习^

weer2

没有大神帮忙吗

weer2

还在等啊    哎

基督的烤鸭

你是不是把EXCEL文件保存为XLSM了？

基督的烤鸭

我测试了一遍没问题啊，另外我改了个直接引用固定工作表的代码，使用的时候，把中间三个提示框MsgBox删掉就好了。

Sub 宏2()
Dim p As String
Dim p1 As String
p1 = Documents(ActiveDocument.Name).Path '取得WORD文档的绝对路径
MsgBox "本文件的路径为：" & p1
Dim qgrmdtj()
myPath = p1         '把文件路径定义给变量
n = 1
myFile = Dir(myPath & "\*.xls") '获取excel文件名
If myFile = "" Then
myFile = Dir(myPath & "\*.xlsx") '当没有xls文件时，改查xlsx文件，获取excel文件名
Else
End If
MsgBox "数据源的名字为：" & myFile
p = p1 & "\" & myFile ''计算出名Excel数据源绝对路径
MsgBox "本文件的绝对路径为：" & p
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=37;Jet OLEDB:Database L" _
        , SQLStatement:="SELECT * FROM `引用$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
        ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle '点击预览结果按钮
End Sub



另外有没有高手能把这段代码精简一下，格式必须是这么怪异吗？



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=37;Jet OLEDB:Database L" _
        , SQLStatement:="SELECT * FROM `引用$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess