在stack上一些用户的帮助下，我编译了一个宏，该宏从excel工作簿中提取某些值，并将它们复制到word模板中。该宏有时工作正常，但在其他情况下，我得到一个错误-“运行时错误-2146950355（80080005）：服务器执行失败”。我不知道为什么我有时会得到这个错误，但不是其他人。附件是我的代码和屏幕截图的错误和调试。

Const FilesPath As String = "filespath"
Const FilesPathh As String = "filespathh"
Const FilesPathhh As String = "filespathhh"
Const TemplateFile As String = "tempa.docx"

Sub Letters()
    Dim wd As Word.Application, doc As Word.Document
    Dim NomCell As Range, ws As Worksheet
    Dim Result As Integer
    

    Set ws = ActiveSheet
    Set wd = New Word.Application
    wd.Visible = True
    

   Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight
    Application.CutCopyMode = False
        
        
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("H:H").Select
    Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=True, Other:=False, FieldInfo:= _
        Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Last Name"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "First Name"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Other"
    
    

For Each NomCell In ws.Range("A2", ws.Cells(Rows.Count, 1).End(xlUp)).Cells
        'open as read-only
        
        
        Set doc = wd.Documents.Open(FilesPath & TemplateFile, ReadOnly:=True)
        With NomCell.EntireRow
        
        doc.Bookmarks("date").Range.Text = Date
        doc.Bookmarks("name").Range.Text = .Columns("I").Value
        doc.Bookmarks("course").Range.Text = .Columns("A").Value
    .Columns("A").Select
    Selection.Replace What:="&", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:=":", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="/", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        
               doc.SaveAs2 FilesPathh & .Columns("K").Value & " " & .Columns("A").Value & ".pdf", _
                                                   wdExportFormatPDF
               doc.Close False
            
        End With
    Next NomCell
    wd.Quit
    ActiveSheet.Cells.ClearContents
    Result = MsgBox("The letters have been created. Would you like to view them?", vbYesNo)
    If Result = vbYes Then
    Call Shell("explorer.exe " & FilesPathhh, vbNormalFocus)
    End If
End Sub

任何帮助都将不胜感激。谢谢！