我正在尝试设置VBA以在word中运行邮件合并，同时使用活动电子表格作为合并的数据源。目前使用我的VBA，我可以打开我的文档（在示例中删除了文件路径），但是它失败并出现运行时错误438，对象不支持此属性或方法。
是否有人可以提供调整以使文档与活动工作表合并？
非常感谢！
（应该补充一点，我这样做是因为最终会有3个文件从一张纸上更新，因为每次数据都是变量，所以在Excel中改变一件事似乎比同样的东西更容易在Word中3次。
Private Sub CommandButton1_Click()
Dim xls As Excel.Application
Set xls = New Excel.Application
Dim sPathFileTemplate As String
sPathFileTemplate = "FILENAME of Doc to be opened"
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
' setup the template document
Set wdDoc = wdApp.Documents.Open("FILENAME of Doc to be opened")
Dim sIn As String
sIn = ThisWorkbook.FullName 'This Workbook is set the merge data source
' open the MERGE
wdApp.MailMerge.OpenDataSource Name:=sIn, _
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=" & sXLSPathFile & ";" & _
"Mode=Read;Extended Properties=" & _
"HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" _
, SQLStatement:="SELECT * FROM `Sheet1$`", _
SQLStatement1:=sSQLWhere, _
SubType:=wdMergeSubTypeAccess
' do the MERGE
With doc.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
'If you want you can delete this part and proceed to diretly define the
'filename and path below in "OutputFileName"
On Error Resume Next
Dim FileSelected As String
FileSelected = Application.GetSaveAsFilename(InitialFileName:="Export", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Save PDF as")
If Not FileSelected <> "False" Then
MsgBox "You have cancelled"
doc.Close False
Set doc = Nothing
wrdApp.Quit False
Set wrdApp = Nothing
Exit Sub
End If
If FileSelected <> "False" Then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
wrdApp.Application.Options.SaveInterval = False
doc.Close False
Set doc = Nothing
wrdApp.Quit False
Set wrdApp = Nothing
MsgBox "Done"
End If ' this EndIf pretains to the SaveAs code above
End Sub