我写了一个Excel> Word Mail合并,其中word文档是邮件合并模板。
目前,必须对excel文件(数据源)的位置进行硬编码。
我希望能够移动有关网络的文件,只要它们在彼此相同的文件夹中,因此它识别数据源仍然是excel文件。
我目前有这段代码我认为可以使用。当word文档在任何时候打开时,它将通过查看文件的当前目录并查找文件名PM MailMerge.xlsm来重新创建数据源。
然后,当它创建时,消息框应显示新的mailmerge数据源。
这样可行,但是当我将这两个文件移动到任何其他文件夹时,它会失败并说无法找到数据源。
代码:
Private Sub Document_Open()
Dim strBook As String
Dim strBookName As String
Dim strDataSource As String
strBookName = "\PM MailMerge.xlsm"
strBook = ActiveDocument.Path & strBookName
strDataSource = ActiveDocument.MailMerge.DataSource.Name
ActiveDocument.MailMerge.OpenDataSource Name:= _
strBook, _
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=strBook;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:D", _
SQLStatement:="SELECT * FROM `Merge$`", _
SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
MsgBox "Current Datasource - " + strDataSource
End Sub
答案 0 :(得分:3)
它失败,因为Word在执行Document_Open之前尝试连接到现有数据源。但是,恰恰发生了什么以及您看到的内容至少取决于以下内容:
粗略地说......
如果数据源Word尝试查找仍然存在,除了一个以外的所有情况下,只要用户对他们看到的任何安全提示响应“是”,Word就会建立连接。例外情况是,如果SQLSecurityCheck不存在或设置为1(即默认值),则通过OLE自动化打开文档,并将DisplayAlerts设置为wdAlertsNone,不显示任何对话框,并且不打开数据源。
如果数据源Word尝试查找不存在(例如已移动),则在除一个用户之外的所有情况下,用户都将看到错误对话框。如果他们对该对话框的响应是识别有效的数据源,则该文档将具有新的数据源。同样,异常是当SQLSecurityCheck是默认值时,文档通过OLE打开,DisplayAlerts设置为wdAlertsNone。在这种情况下,不会显示任何对话框,也不会打开数据源。
开发人员面临的一个问题是,如果SQLSecurityCheck值已更改为0(通常是为了让用户不得不一直回答安全检查问题),则无法避免在数据源不存在时弹出用户对话框。
但是,只要用户能够查看并响应Word在连接到数据源时显示的任何对话框,用户将以(a)带有附加数据源的打开文档结束,或者(b)没有附加数据源的开放文档(或者可以说是其他一些混乱,例如用户试图结束Word过程或其他类似过程)。如果发生这两件事中的任何一件,那么应该运行Document_Open代码并且Word应该最终连接到您想要的数据源。 (虽然在某些情况下,当使用不同的方法连接到Word时,尝试连接到现有数据源(如文本文件)可能会导致错误。)
顺便说一下,
答案 1 :(得分:2)
我遇到了同样的问题。我解决了它: 1. MainDocumentType = wdNotAMergeDocument(必须设置为普通文档,否则单词在打开时始终有问题)。 2.启动vba函数后,读取当前文档路径并运行附加函数:
enter code here
Function Start_MMerge(xdoc As Document, SBD_Name As String) As Integer
On Error GoTo Start_MMergeError
Dim vFile As String
vFile = Dir(SBD_Name) 'prüft, ob es die Datei SBD_Name überhaupt gibt
If Len(vFile) <> 0 Then
xdoc.MailMerge.MainDocumentType = wdFormLetters
xdoc.MailMerge.OpenDataSource Name:= _
SBD_Name, _
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=" & SBD_Name _
& ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";
Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Da" _
, SQLStatement:="SELECT * FROM `Adressen$` WHERE [E-Mail senden]='nein'", SQLStatement1:="",
SubType:=wdMergeSubTypeAccess
xdoc.MailMerge.MainDocumentType = wdFormLetters
With xdoc.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
Start_MMerge = -1
Else
Start_MMerge = 0
End If
Start_MMergeExit:
xdoc.MailMerge.MainDocumentType = wdNotAMergeDocument
Exit Function
Start_MMergeError:
Start_MMerge = 0
Resume Start_MMergeExit
End Function
enter code here