View Single Post
 
Old 08-07-2024, 04:09 AM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,176
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

I've streamlined the logic of your code so it is cleaner but I'm not sure it will solve your issue and I don't have a file to do any testing on. Give this a try and if you cross your fingers you might find it works
Code:
Sub test_update(docPath As String, dataSourcePath As String, sqlQuery As String)
    Dim wdApp As Object, wdDoc As Object

    ' Open Word application
    On Error Resume Next
      Set wdApp = GetObject(, "Word.Application")
      If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
      End If
    On Error GoTo 0
    If wdApp Is Nothing Then    ' Check if Word application is open
      MsgBox "Unable to open or create Word application.", vbExclamation
      Exit Sub
    End If

    ' Open the Word document
    On Error Resume Next
      wdApp.DisplayAlerts = False
        Set wdDoc = wdApp.Documents.Open(docPath, False, True, False, , , , , , , , True) 'set object as Word document used as base
      wdApp.DisplayAlerts = True
      ' Ignore specific merge file errors
      If Err.Number <> 0 Then Err.Clear
    On Error GoTo 0
    If wdDoc Is Nothing Then
      MsgBox "Unable to open the Word document: " & docPath, vbExclamation
      Exit Sub
    End If

    ' Update the data source
    On Error GoTo HandleError       'This will send the macro down to HandleError before returning
    With wdDoc.MailMerge
        .MainDocumentType = 0 ' wdFormLetters
        .OpenDataSource Name:=dataSourcePath, _
                        ConfirmConversions:=False, ReadOnly:=True, _
                        LinkToSource:=True, AddToRecentFiles:=False, _
                        PasswordDocument:="", PasswordTemplate:="", _
                        WritePasswordDocument:="", WritePasswordTemplate:="", _
                        Revert:=False, Format:=0, _
                        Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & dataSourcePath & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
                        SQLStatement:=sqlQuery
    End With

    ' Save and Close the document
    wdDoc.Close SaveChanges:=True

    ' Quit Word application if no other documents are open
    If wdApp.Documents.Count = 0 Then wdApp.Quit SaveChanges:=False

    ' Release objects
    Set wdDoc = Nothing
    Set wdApp = Nothing

    MsgBox "Mail merge data source updated and document saved.", vbInformation
    Exit Sub

HandleError:
    ' Handle errors
    If Err.Number <> 0 Then
        ' Ignore known errors related to database engine
        Debug.Print "Error: " & Err.Number
        If Err.Number = 123 Or Err.Number = 112 Then
          Err.Clear
          Resume Next
        Else
            MsgBox "An unexpected error occurred: " & Err.Number & vbCr & Err.Description, vbExclamation
            If Not wdDoc Is Nothing Then wdDoc.Close SaveChanges:=False
            If wdApp.Documents.Count = 0 Then wdApp.Quit SaveChanges:=False
            Set wdDoc = Nothing
            Set wdApp = Nothing
        End If
    End If
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote