How to resolve runtime errors copying from excel to word

问题

I am currently working on an excel Userform to generate a report for a lot entered on a given day. The report is stored in a separate word document which contains the results of between 1 and 8 quality samples (number of samples varies by lot). The Userform is meant to load in excel, receive a lot number and date from the user, retrieve samples from that day and lot from a different sheet in the excel workbook and then copy the data into a new word doc based on a custom template. I have inserted the MsgBox method into the macro at various points for bug-squashing purposes. The data set I am using is organized by both date and lot number (in columns A and C, respectively) and the goal of the macro I am writing is to copy all rows containing a chosen date and lot number into a word document.

I have encountered an error as my macro attempts to copy the data over to word. I get runtime error 5941, which Microsoft docs say indicates that the document isn't open, but my code explicitly opens the word document into which I aim to copy my data. As far as I can tell, I haven't made any glaring errors in accessing word objects, but I am also a newbie VBA programmer, so it's possible I missed something.

Sub makeReport(lNum As Integer, pDay As Date, name As String)
    'Template Path: \\CORE\Miscellaneous\Quality\Sample Reports\Template\Defect Report.dotm
    'Save path for finished report: \\CORE\Miscellaneous\Quality\Sample Reports
    
    'Initialize word objects and open word
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Dim wdCell As Word.Cell
    
    'MsgBox ("Word Doc Opened")
    
    Set wApp = New Word.Application
    wApp.Visible = True
    Set wDoc = wApp.Documents.Add(Template:=("\\CORE\Miscellaneous\Quality\Sample Reports\Template\Defect Report.dotm"), NewTemplate:=False, DocumentType:=0)
    
    'MsgBox ("Word Objects Initialized")
    
    'Fill in lot number and date at top of report
    With wDoc
        .Application.Selection.Find.Text = "<<date>>"
        .Application.Selection.Find.Execute
        .Application.Selection = Format(pDay, "mm/dd/yyyy")
        .Application.Selection.EndOf
    
        .Application.Selection.Find.Text = "<<lot>>"
        .Application.Selection.Find.Execute
        .Application.Selection = lNum
    End With
    
    'MsgBox ("Filled in pack date and lot number")
    
    'Initialize excel objects
    Dim wBook As Workbook
    Dim wFunc As WorksheetFunction
    
    Set wFunc = Application.WorksheetFunction
    Set wBook = ThisWorkbook
    
    Worksheets("Defect Table").Activate
    Application.ActiveSheet.UsedRange.Select
    
    'MsgBox ("Set Active Sheet to Defect Table")
    
    'Initialize copy control variables
    Dim x As Integer
    Dim y As Integer
    
    x = Selection.Rows.count
    
    MsgBox ("Number of rows: " + CStr(x))
    
    Dim numArray() As Integer
    Dim dateArray() As Date
    Dim hold(0 To 7) As Integer
    Dim i As Integer
    Dim msg As String
    Dim c As Integer
    Dim d As Integer
    Dim e As Integer
    Dim f As Integer
    Dim temp As Variant
    Dim sample(0 To 29) As Variant
    
    i = 0
    ReDim numArray(2 To x)
    ReDim dateArray(2 To x)
    
    For y = 2 To x
        'Array which holds all lot numbers
        numArray(y) = CInt(Application.ActiveSheet.Cells(y, 3).Value)
        
        'Array which holds all dates
        dateArray(y) = CDate(Application.ActiveSheet.Cells(y, 1).Value)
        
        If (lNum = numArray(y) And pDay = dateArray(y)) Then
            hold(i) = y
            i = i + 1
        End If
        
    Next y
    
    msg = "Appropriate samples found." + vbCrLf + "Rows: "
    
    For i = 0 To 7
        msg = msg + vbCrLf + CStr(hold(i))
    Next i
    
    MsgBox (msg)
    
    'Copies samples over to word doc
    For i = 0 To 7
        
        d = hold(i)
        If d = 0 Then
            Exit For
        End If
        For c = 4 To 32
            e = c - 4
            
            If e = 30 Then
                e = e + 1
                c = c + 1
            End If
            
            sample(e) = ActiveSheet.Cells(d, c).Value
            
            
            f = 1
            
            For Each wdCell In wDoc.Tables(1).Columns(i).Cells
                
                Select Case f 'Accounts for gaps in lines 6, 10, 16, 22, 30 of word doc
                    
                    Case 6, 10, 16, 22, 30
                        f = f + 1
                    
                    Case Else
                        f = f
                
                End Select
                
                wdCell.Range.Text = sample(f)
                
                f = f + 1
            Next wdCell
        Next c
    Next i
    
    '---MsgBox ("Data copied to Word Doc")
    
    'Saves Document using regular name format for ease of access
    '---wDoc.SaveAs2 Filename:="\\CORE\Miscellaneous\Quality\Sample Reports\" + name, FileFormat:=wdFormatDocumentDefault, AddtoRecentFiles:=False
    
    'Zeroes out word/excel objects
    '---Set wDoc = Nothing
    '---Set wApp = Nothing
    '---Set wBook = Nothing
    
    '---MsgBox ("Report saved and objects zeroed out")
End Sub

来源：https://stackoverflow.com/questions/65617987/how-to-resolve-runtime-errors-copying-from-excel-to-word