dcsimg
Results 1 to 1 of 1

Thread: Wanting to change an MS Word MailMerge Datasource using VBA ?

  1. #1

    Thread Starter
    New Member
    Join Date
    Jul 2019
    Posts
    1

    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.
    Last edited by Shaggy Hiker; Jul 26th, 2019 at 11:13 AM. Reason: Added CODE tags.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width