How to alter vba code to correct Error Code 4248 when trying to mail merge into a word document?-CodePudding

My goal is to use two dropdown menus (DM) within a workbook to open a filled-out document. The DM 1 is to select which row of data will be merged; the DM 2 is to select which template is being used. I have separate code that highlights the selected row and opens the document.

This line gives me the error: 4248 This command is not available because no document is open. "Set doc = appWD.ActiveDocument"

However, the template I want is open when I receive this error.

For Context: Open_LPA_Template, when ran by itself, does correctly open the word document that I have selected from the DM 2.

Select_Parcel, when ran by itself, does correctly highlight the row of data that I selected from DM 1.

Sub Run_Mail_Merge_LPA()
    Dim doc As Word.Document
    Dim appWD As Object
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim tbl As ListObject
    Dim row As ListRow
    Dim searchValue As String
    Dim searchRange As Range
    Dim foundCell As Range
    
    ' Get references to the workbook and worksheets
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets(1)
    Set ws2 = wb.Worksheets(2)
    
    ' Create an instance of the Word application
    Set appWD = CreateObject("Word.Application")
    
    ' Open the Word document that has been selected in DM 2

    Open_LPA_Template
    
    ' Select_Parcel's CODE: Select the Row of Data from DM 1 for the Mail Merge

    ws2.Select
    ' Select cell D3 in worksheet 2
    ws2.Range("D3").Select
    
    ' Store the value in D3 of worksheet 2 in a variable
    searchValue = ws2.Range("D3").Value
    
    ' Set the search range to the entire column A of worksheet 1
    ws.Select
    Set searchRange = ws.Range("A:A")
    
    ' Use the Find method to search for the search value in the search range
    Set foundCell = searchRange.Find(searchValue)
    
    If Not foundCell Is Nothing Then
        ' If a match is found, select the cell
        foundCell.Select
        ActiveCell.EntireRow.Select
    Else
        ' If no match is found, print a message
        Debug.Print "Value not found in column A"
    End If

    ' MAIL MERGE CODE: Set the active document to the Word document that was opened
    Set doc = appWD.ActiveDocument
    
    ' Perform the mail merge
    doc.MailMerge.MainDocumentType = wdFormLetters
    doc.MailMerge.OpenDataSource _
        Name:=row.Range, _
        ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:=""
    doc.MailMerge.Execute
End Sub

If anyone can help or rework the code to be more efficient, please do. I am a novice and it's a miracle that I have gotten this far. :)

EDIT - CODE FOR OPEN_LPA_TEMPLATE Sub Open_LPA_Template()

Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim MainPath As String
Dim MainPath2 As String
Dim MainPath3 As String
Dim MainPath4 As String
Dim MainPath5 As String
Dim MainPath6 As String
Dim Parcel As String
Dim fileName As String
Dim FullPath As String
Dim mWord As Object

Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
Set ws2 = wb.Worksheets(2)
Set appWD = CreateObject("Word.Application")
appWD.Visible = True

MainPath = "C:\Users\ME\Dropbox (ORC)\Desktop\Templates\LPA\"
MainPath2 = "C:\Users\USER1\Dropbox (ORC)\Desktop\Templates\LPA\"
MainPath3 = "C:\Users\USER2\Dropbox (ORC)\Desktop\Templates\LPA\"
MainPath4 = "C:\Users\USER3\Dropbox (ORC)\Desktop\Templates\LPA\"
MainPath5 = "C:\Users\USER4\Dropbox (ORC)\Desktop\Templates\LPA\"
MainPath6 = "C:\Users\USER5\Dropbox (ORC)\Desktop\Templates\LPA\"
    
fileName = ws2.Range("E3")

 ' Check if the file exists at the first path
If Dir(MainPath & fileName & ".docx") <> "" Then
    FullPath = MainPath & fileName & ".docx"
ElseIf Dir(MainPath2 & fileName & ".docx") <> "" Then
    ' If the file does not exist at the first path, check the second path
    FullPath = MainPath2 & fileName & ".docx"
ElseIf Dir(MainPath3 & fileName & ".docx") <> "" Then
    ' If the file does not exist at either of the first two paths, check the third path
    FullPath = MainPath3 & fileName & ".docx"
ElseIf Dir(MainPath4 & fileName & ".docx") <> "" Then
    ' If the file does not exist at any of the first three paths, check the fourth path
    FullPath = MainPath4 & fileName & ".docx"
ElseIf Dir(MainPath5 & fileName & ".docx") <> "" Then
    ' If the file does not exist at any of the first four paths, check the fifth path
    FullPath = MainPath5 & fileName & ".docx"
Else
    ' If the file does not exist at any of the first five paths, use the sixth path
    FullPath = MainPath6 & fileName & ".docx"
End If

appWD.Documents.Open (FullPath)

There are six different paths because it could be accessed/used by six different people who get to the shared word documents through their own computers.

CodePudding user response：

Since you are creating a new instance of Word via

Set appWD = CreateObject("Word.Application")

That Word instance has no open documents. You need to open the relevant document and address it via code like:

Set doc = appWD.Documents.Open(Filename:="C:\Users\Aaron Bradow\Documents\Mail Merge Document.docx", AddToRecentFiles:=False, ReadOnly:=True)

CodePudding user response：

The problem is that you create two separate instances of Word Application in the code and try to access a Document instance opened in another Word Application instance/process. If you want to use the ActiveDocument property you need to deal with a single Word Application instance in the code. So, you may pass a created Word Application instance as a parameter to the method to open files.

Be aware, the Documents.Open function from the Word object model opens the specified document and adds it to the Documents collection. It also returns a Document object which can be used instead of the ActiveDocument property in the code.

Sub OpenDoc() 
  Dim doc As Word.Document
  Set doc = Documents.Open FileName:="C:\MyFiles\MyDoc.doc"
End Sub