excel 邮件合并到Word文档生成错误代码4248

xzv2uavs  于 2023-01-03  发布在  其他
关注(0)|答案(2)|浏览(334)

我的目标是在一个工作簿中使用两个下拉菜单(DM)来打开一个填写好的文档。
DM 1将选择哪一行数据将被合并。
DM 2将选择正在使用的模板。
我有单独的代码突出显示选定的行并打开文档。
Set doc = appWD.ActiveDocument给了我
错误4248此命令不可用,因为没有打开文档。
收到此错误时模板已打开。
对于上下文:
Open_LPA_Template本身运行时,确实会打开从DM 2中选择的Word文档。
Select_Parcel单独运行时,会突出显示从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
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)

有六个路径,因为它可以访问/使用的六个人谁获得共享的Word文档通过自己的电脑。

ekqde3dh

ekqde3dh1#

由于您正在通过创建Word的新示例

Set appWD = CreateObject("Word.Application")

该Word示例没有打开的文档。您需要打开相关文档,并通过如下代码对其进行寻址:

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

a2mppw5e2#

问题是,您在代码中创建了两个单独的Word Application示例,并试图访问在另一个Word Application示例/进程中打开的Document示例。如果要使用ActiveDocument属性,则需要在代码中处理单个Word Application示例。因此,您可以将创建的Word Application示例作为参数传递给打开文件的方法。
请注意,Word对象模型中的Documents.Open函数会打开指定的文档并将其添加到Documents集合中。它还返回一个Document对象,该对象可用于代替代码中的ActiveDocument属性。

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

相关问题