Access VBA生成Word主文档二次运行报462错误求助

• 首次运行代码完全正常，但后续每次运行都会触发错误：Error No:462，错误描述：远程服务器机器不存在或不可用，报错行位于Selection.WholeStory
• 报错时已确认任务管理器中无Word进程运行，重启Access后首次运行可恢复正常
• 文件存储文件夹未开启OneDrive同步，且已尝试多种Word对象初始化方式（包括早绑定、晚绑定）及参考其他解决方案，均未解决问题

完整函数代码 #

Public Function f_Test(lID As Long, strSQL As String)
  
    Dim objWord As Word.Application
    Dim blnWordCreated As Boolean
    
    Dim NewDoc As Word.Document
    Dim TemplateDoc As Word.Document

    Dim strTemplatePath As String
    
    Dim strNewFilePath As String
    Dim strNewFileName As String
    
    Dim rs As DAO.Recordset

On Error Resume Next
    
    blnWordCreated = False
    
    Set objWord = GetObject(, "Word.Application")
    
    If Err.Number <> 0 Then
    
        Err.Clear
        Set objWord = New Word.Application
        blnWordCreated = True
        objWord.Activate
        objWord.Visible = True
        
    End If

 On Error GoTo Error_Handler
         
    Set rs = CurrentDb.OpenRecordset(strSQL)
    
    If rs.RecordCount > 0 Then
    
        With rs
        
            strNewFilePath = "c:\Test\" & lID & "\"
            strNewFileName = strNewFilePath & "Empty " & f_GetDateForUseInFileName(Now()) & ".docx"
            
            .MoveFirst

            Set NewDoc = objWord.Documents.Add  'Create a new document
            NewDoc.SaveAs2 strNewFileName
            
            Do Until .EOF
                
                strTemplatePath = !FileName
                Set TemplateDoc = objWord.Documents.Open(FileName:=strTemplatePath)
                
                ' Copy Entire Document
                TemplateDoc.Activate
                Selection.WholeStory ' THIS IS WHERE IT ERRORS OUT ON SUBSEQUENT RUNS
                Selection.Copy
                
                ' Activate New Document and Paste
                NewDoc.Activate
                Selection.PasteAndFormat (wdUseDestinationStylesRecovery)
                Selection.InsertBreak Type:=wdPageBreak

                ' Close Template without saving
                TemplateDoc.Close SaveChanges:=wdDoNotSaveChanges
                .MoveNext
            Loop

        End With
    End If

Exit_Routine:

    ' cleanup
    rs.Close
    Set rs = Nothing
    
    NewDoc.Close SaveChanges:=wdSaveChanges

    Set TemplateDoc = Nothing
    Set NewDoc = Nothing
    
    If blnWordCreated Then
        objWord.Quit
        Set objWord = Nothing
    End If
    
    Exit Function

Error_Handler:
    
    Debug.Print Err.Number & " " & Err.Description
    Resume Exit_Routine

End Function

内容的提问来源于stack exchange，提问作者Dennis