Wanting to change an MS Word MailMerge Datasource using VBA ?

Wanting to change an MS Word MailMerge Datasource using VBA ?

The method provided is OpenDataSource, but that requires a ‘Name’ which is that of a suitable file (usually Data Connection (.odc) file) ; even though all you want to change is the Connection string.
It does require a genuine accessible file, however it does appear to be willing to take an empty file, so I offer the following:

Code:

---

Function UpdateMailMergeDataSourceConnection(ByVal sNew_Connect As String, Optional ByRef oDoc As Word.Document) As Boolean
    ' to update a MailMergeDataSource with the passed connection string
    If sNew_Connect = "" Then Exit Function
    If oDoc Is Nothing Then Set oDoc = ThisDocument
    If oDoc.MailMerge.DataSource.ConnectString <> sNew_Connect Then
        With oDoc.MailMerge.DataSource
            oDoc.MailMerge.OpenDataSource _
                Name:=getEmptyFile("Dummy.odc"), _
                Connection:=sNew_Connect, _
                SqlStatement:=Mid(.QueryString, 1, 255), _
                SqlStatement1:=Mid(.QueryString, 256, IIf(Len(.QueryString) > 255, Len(.QueryString) - 255, 0)), _
                LinkToSource:=True, _
                AddToRecentFiles:=False
        End With
    End If
   
    UpdateMailMergeDataSourceConnection = (oDoc.MailMerge.DataSource.ConnectString = sNewConnect)
End Function

‘ including a function to create such an empty file (used above)

Function getEmptyFile(Optional ByVal Name As String = "Empty.File") As String
    ' create as empty file (or existing such)
    ' default to TempFolder \ filename as per optional parameter setting above
    ' appending (N) fo filename if needing to avoid non-empty extant files
    ' returns fullfilepath or "" if unsuccessful
    Dim oFSO As Object 'FileSystemObject
    Dim sPath As String, sFN1 As String, sFN As String, sExtn As String
    Dim sFile0 As String, ix As Integer
    On Error GoTo getEmptyFile_Exit
   
    'Set oFSO = New FileSystemObject
    Set oFSO = CreateObject("Scripting.FileSystemObject")
   
    ' split into components so can default element and rebuild to generate avaliabele 0-byter later
    sFN = oFSO.GetBaseName(Name)
    sExtn = oFSO.GetExtensionName(Name)
    If InStr(1, Name, "") <> 0 Then
        sPath = oFSO.GetParentFolderName(Name)
        If Not oFSO.FolderExists(sPath) Then sPath = oFSO.GetSpecialFolder(2)    ' Temporary folder
    Else
        sPath = oFSO.GetSpecialFolder(2)    ' Temporary folder
    End If
    If sExtn <> "" Then sExtn = "." & sExtn

    sFN1 = sFN
    Do
        sFile0 = oFSO.BuildPath(sPath, sFN & sExtn)
        If Not oFSO.FileExists(sFile0) Then Exit Do    ' filepath not exit so can create such
        If oFSO.GetFile(sFile0).Size = 0 Then Exit Do  ' already exist and is 0-byte so can use
        ix = ix + 1                                    ' already exists but non-0 so try another name
        sFN = sFN1 & "(" & CStr(ix) & ")"
    Loop

    If Not oFSO.FileExists(sFile0) Then
        'On Error Resume Next ' in case cant create
        oFSO.CreateTextFile(sFile0).Close              ' make empty file
    End If
   
    If oFSO.FileExists(sFile0) Then getEmptyFile = sFile0

getEmptyFile_Exit:
Set oFSO = Nothing
End Function

---

Hope you find this useful.