2003、2007、2010版VBA邮件合并数据源相对路径，数据源自动加载，邮件合并自由移动。

jzgpd

        由于工作需要，我有十多个文档对应一个数据源。我经常要移动邮件合并的主文档和数据源，有时也可能发给客户（谁知他会在哪个路径打开。。。。），但一移动就得全部重新指定数据源，大大降低了我对邮件合并的兴趣。 邮件合并相对路径的问题困惑了我很多年，在网上查找也很难找到，反正我是没找到。最近终于发现了2003版可以通过修改设置的方法实现，可惜单位和家中的电脑全换成2007或2010版的了，网上说设置的方法2007也行，但我反正是没弄成功，也找到了两三种VBA代码，可惜对于我这种只有小学水平的E人是无法移植到自己文档中的。。。。由于工作中确实需要，没法只好自己动手，中秋放假，弄到早上5点，终于成功。非常高兴，特发出来大家讨论，也希望给和我同样困扰的朋友一种解决方案。
      这种方法对于经常移动邮件合并的人特别有用。只要邮件合并主文档和数据源在同一个目录内，无论移到什么地方，打开主文档都可以自动载入数据源。
   
    该宏设为主文档打开时自动运行，自动取得与邮件合并主文档同一目录下指'定文件名Excel数据源的绝对路径（标题不该叫相对路径了，可以叫自适路径），并载入Excel数据源到主文档。需要说明的是：在新路径第一次打开文件弹出"“数据库' 中的数据将被放置到文档中”，是否继续？”时，应选否。运后一次后，由于新路径已经记录保存，选是或否都无所谓了，
    本宏Excel数据源可以在工作簿的任意位置，没有只能在第一个的限制,工作表只能叫“数据源”（如果非要改，也可以在代码中去改。但我试了下，没法将它设为变量），工作簿名字可在代码中的变量赋值部份修改，数据源工作表名称的修改就自己找找吧。
    如果哪个高手有兴趣，可以改改看能不能将数据源工作表的名称设为变量。
邮件合并.rar (16 KB, 下载次数: 142)

2013-9-19 14:32 上传

点击文件名下载附件

    进行了改进，将Excel数据源工作表的名称设为了变量，修改起来更方便。 邮件合并2.rar (16.32 KB, 下载次数: 341)

2013-9-21 08:32 上传

点击文件名下载附件

lrt99

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

wxsunhao

先下载试试，这个东东应该是非常想要的

HOTOSSON

打开显示路劲错误

bttc3h3

先标记，后头研究一下

ph378

学习了。强大呀

zhoujieses

版主力作，谢谢分享

hz_wst

打开路径错误，谢谢分享

weer2

lrt99 发表于 2015-1-8 21:23
Sub AutoOpen()
'
' Auto_Open宏 该宏设为主文档打开时自动运行，自动取得与邮件合并主文档同一目录下
...

哈哈 这个牛逼

weer2

lrt99 发表于 2015-1-8 21:23
Sub AutoOpen()
'
' Auto_Open宏 该宏设为主文档打开时自动运行，自动取得与邮件合并主文档同一目录下
...

最近的office2016出现这个错误，不知道有什么办法没有？