VBA mailmerge 无法使用 访问数据源。OpenDataSource 和 SQLStatement 参数

问：

我的公司目前正在过渡到 SharePoint，因此我必须更新我们的 VBA 宏来处理这一移动。

其中一个宏涉及使用 CSV 文件，并使用如下所示的代码对其执行 SQLStatement 调用。我没有包含所有代码，因为它很长，包括按预期工作的部分。如果我需要包含整个内容，请告诉我（我已经包含了一个注释来表示导致错误的代码部分）。

它给出错误：“Word 无法打开数据源”。

''create a uniquely named CSV file that contains all merge data
randomiserString = Ctrl.Range("Timestamp").Value
currentDirectory = Wb1.Path
docTemplatePath = Ctrl.Range("Address_Merge_Template").Value
user = Application.UserName
modifiedUserString = Replace(user, " ", ".")
filepathDataCSV = "c:\Users\" + modifiedUserString + ".LWP\London Wall Partners LLP\London Wall Partners LLP - Administration\Development\Automation\Report Mail Merges\CSV dumps\" + randomiserString + ".csv"

''create the CSV
Wb1.Sheets("Data").Copy
'xlCSVUTF8 is required FileFormat for handling certain characters e.g. é or %.
ActiveWorkbook.SaveCopyAs Filename:=filepathDataCSV 'FileFormat:=xlCSVUTF8, CreateBackup:=False
ActiveWorkbook.Close

Ctrl.Range("Address_CSV").Value = filepathDataCSV

'Create Word file
Application.StatusBar = "Creating Word file..."
Set wApp = CreateObject("Word.Application")
wApp.Visible = True
Set wDoc = wApp.Documents.Add(Template:=docTemplatePath, NewTemplate:=False, DocumentType:=0)

'GoTo MailMergePrep:
ImportFromRecEng:
'Parameters for grabbing data and images from RecEng.  Includes a skip clause if no RecEng has been imported.
RecEngFilepath = Ctrl.Range("Address_RecEng").Value
Set RecEng = Workbooks.Open(RecEngFilepath)

'Section to insert tables into s3 and rec schedules.
For i = 0 To ArrayLength_RecsSummary
    If RecsSummary.Range("RecsSummaryAnchor").Offset(i + 1, 1).Value > 0 Then
        TableToCopy = RecsSummary.Range("RecsSummaryAnchor").Offset(i + 1).Value
         If wDoc.Bookmarks.Exists(TableToCopy) Then
         On Error Resume Next
         Debug.Print Range(TableToCopy).Rows.Count
          If Err = 1004 Then
          'Range does not exsist in RecEng
          Else
           If (InStr(1, TableToCopy, "Sells") <> 0 Or InStr(1, TableToCopy, "SwOut") <> 0) Then TableToCopy_Buys = RecsSummary.Range("RecsSummaryAnchor").Offset(i + 2).Value Else TableToCopy_Buys = "Null"
           RecEng.Activate
           Application.GoTo Range(TableToCopy)
          Selection.Copy
          wDoc.Activate
          wDoc.Bookmarks.DefaultSorting = wdSortByName
          wDoc.Bookmarks.ShowHidden = False
          wDoc.Bookmarks(TableToCopy).Select
          wApp.Selection.PasteSpecial Link:=False, DataType:=9, Placement:=0, DisplayAsIcon:=False
              If (InStr(1, TableToCopy, "Sells") <> 0 And InStr(1, TableToCopy_Buys, "Buys") <> 0) Or (InStr(1, TableToCopy, "SwOut") <> 0 And InStr(1, TableToCopy_Buys, "SwIn") <> 0) Or (InStr(1, TableToCopy, "Schedule") <> 0) Then
              With wApp.Selection
                .Collapse Direction:=wdCollapseEnd
                .TypeParagraph
              End With
              End If
        End If
        End If
    End If
    Err.Clear
    On Error GoTo 0
Next i
Application.CutCopyMode = False
RecEng.Close SaveChanges:=False

'Section for deleting irrelevant account blocks from s3.1 and s3.2.  CG 19/2/20: This should also work for the investment schedules.
For i = 0 To ArrayLength_RecsSummary4
    If RecsSummary.Range("RecsSummaryAnchor4").Offset(i + 1, 1).Value = 0 Then
        TableToDelete = RecsSummary.Range("RecsSummaryAnchor4").Offset(i + 1).Value
        If (TableToDelete <> "" And wDoc.Bookmarks.Exists(TableToDelete)) Then wDoc.Bookmarks(TableToDelete).Range.Cut
    End If
Next i

'Section for deleting irrelevant tables from s3.1 and s3.2.  CG 19/2/20: This should also work for the investment schedules.
For i = 0 To ArrayLength_RecsSummary
    If RecsSummary.Range("RecsSummaryAnchor").Offset(i + 1, 1).Value = 0 Then
        TableToDelete = RecsSummary.Range("RecsSummaryAnchor").Offset(i + 1).Value
        If (TableToDelete <> "" And wDoc.Bookmarks.Exists(TableToDelete) = True) Then wDoc.Bookmarks(TableToDelete).Range.Cut
        'If Sell table exists but Buy table doesn't, need to delete the line break before Buy table.  Could a "delete all blank lines" clause work?
    End If
Next i

'Section for deleting irrelevant paragraphs from s3.1 and s3.2.  CG 19/2/20: This should also work for the investment schedules.
For i = 0 To ArrayLength_RecsSummary3
    If RecsSummary.Range("RecsSummaryAnchor3").Offset(i + 1, 1).Value = 0 Then
        TableToDelete = RecsSummary.Range("RecsSummaryAnchor3").Offset(i + 1).Value
        If (TableToDelete <> "" And wDoc.Bookmarks.Exists(TableToDelete) = True) Then wDoc.Bookmarks(TableToDelete).Range.Cut
    End If
Next i
'Copy and paste s1 and 2
If Ctrl.Range("S1S2_Address").Value <> "" Then
    S1S2Filepath = Ctrl.Range("S1S2_Address").Value
    Doc_Path = S1S2Filepath
    Dim WordDoc As Word.Document
    Set wApp2 = CreateObject("Word.Application")
    wApp.Visible = True
    'Set WordDoc = wApp2.Documents.Open(Doc_Path, ReadOnly:=True)
    Set WordDoc = wApp2.Documents.Add(Template:=Doc_Path, NewTemplate:=False, DocumentType:=0)
    WordDoc.Range.Copy
    wDoc.Activate
    Set Rng = wDoc.Content
    Rng.Collapse Direction:=wdCollapseStart
    Rng.PasteAndFormat wdFormatOriginalFormatting
    'Rng.Paste
    WordDoc.Close SaveChanges:=False

End If
With wDoc.Sections(1).PageSetup
    .DifferentFirstPageHeaderFooter = True
End With

MailMergePrep:
'Prep the mail merge
'The next 6 lines are causing the issue
With wDoc.MailMerge
    .MainDocumentType = wdFormLetters
    sDBPath = filepathDataCSV
    .OpenDataSource Name:=sDBPath, SQLStatement:="SELECT * FROM `'Data$'`"
    .ViewMailMergeFieldCodes = wdToggle
End With

'Export the document.  NB loses connection to CSV.
Application.StatusBar = "Performing mail merge..."
With wDoc
    .MailMerge.Destination = wdSendToNewDocument
    .MailMerge.Execute Pause:=False
End With



wDoc.Close SaveChanges:=False

Application.DisplayAlerts = True
Application.ScreenUpdating = True

Application.StatusBar = False


MsgBox "Recommendations generated successfully and opened in Word."

Actions.Hide

'Application.StatusBar = False

End Sub

我在网上研究过，没有太多关于这方面的文档。我能找到的唯一建议是，如果您纯粹在 SharePoint Online 之外操作，邮件合并根本不起作用，如果您使用 OneDrive 同步功能，则应该可以工作。我们已经设置好了，这就是我正在测试的，但是，错误仍然存在。提前感谢您的帮助！