本人access与VBA双重初学者

最近拟写的一个代码，运行的时候会出现

'-2147023170(800706be)'  错误

并且尝试过删注册表，但是连注册表都找不到

以下是我的代码：

Private Sub button质量数据录入_Click()
    Dim MyDb As DAO.Database
    Set MyDb = CurrentDb()
    Dim yhm As DAO.Recordset
    Set yhm = MyDb.OpenRecordset("select * from 用户信息表 where UserStatus = 1")
    
    Dim wordApp As New Word.Application
    Dim wordDoc As Word.Document
    Dim str As String
    
    Dim sgzb As String
    Dim xczjy As String
    Dim gc As String
     
    
    If check金属管 Then
        gc = "金属管"
    Else
        gc = "塑料管"
    End If
    
    If check施工准备工作是否到位是 Then
        sgzb = "是"
    Else
        sgzb = "否"
    End If
    
    If check现场质检员是否到场是 Then
        xczjy = "是"
    Else
        xczjy = "否"
    End If
    
    Dim glry As String
    Dim sj As String
    
    glry = yhm("UserName")
    sj = CStr(Date)

    str = CurrentProject.Path & "\质量管理信息集成系统\模板文件夹\旁站记录表.dotx"
    Set wordDoc = wordApp.Documents.Add(str, False)
    wordApp.Visible = True
    
    
    With wordDoc.CustomDocumentProperties
        .Item("工程名称").Value = Forms!旁站记录表模板!txt工程名称
        .Item("工程地点").Value = Forms!旁站记录表模板!txt工程地点
        .Item("旁站监理部位").Value = Forms!旁站记录表模板!txt旁站监理部位
        .Item("旁站监理开始时间").Value = Forms!旁站记录表模板!txt旁站监理开始时间
        .Item("施工准备工作是否到位").Value = sgzb
        .Item("现场质检员是否到场").Value = xczjy
        .Item("金铁试验压力").Value = Forms!旁站记录表模板!txt金铁试验压力
        .Item("金铁实测数据").Value = Forms!旁站记录表模板!txt金铁实测数据
        .Item("金铁持续时间").Value = Forms!旁站记录表模板!txt金铁持续时间
        .Item("金铁压力下降").Value = Forms!旁站记录表模板!txt金铁压力下降
        .Item("塑料试验压力").Value = Forms!旁站记录表模板!txt塑料试验压力
        .Item("塑料实测数据").Value = Forms!旁站记录表模板!txt塑料实测数据
        .Item("塑料持续时间").Value = Forms!旁站记录表模板!txt塑料持续时间
        .Item("塑料压力下降").Value = Forms!旁站记录表模板!txt塑料压力下降
        .Item("发现问题").Value = Forms!旁站记录表模板!txt发现问题
        .Item("处理意见").Value = Forms!旁站记录表模板!txt处理意见
        .Item("备注").Value = Forms!旁站记录表模板!txt备注
        .Item("编号").Value = Forms!旁站记录表模板!txt编号
        .Item("日期及气候").Value = Forms!旁站记录表模板!txt日期及气候
        .Item("旁站监理结束时间").Value = Forms!旁站记录表模板!txt旁站监理结束时间
        .Item("金属管or铸铁管").Value = gc
        .Item("金铁检查结论").Value = Forms!旁站记录表模板!txt金铁检查结论
        .Item("塑料检查结论").Value = Forms!旁站记录表模板!txt塑料检查结论
        .Item("旁站监理人员").Value = glry
        .Item("日期").Value = sj
    End With
        
    With wordApp.Selection
        .WholeStory
        .Fields.Update
    End With
    
    wordDoc.SaveAs2 CurrentProject.Path & "\收条("
    Set wordDoc = Nothing
    
    wordApp.Quit
    
    Set wordApp = Nothing
    

End Sub

在线请求各位大神，除了重装系统以外，有没有别的办法可以解决？

本菜鸡在此谢谢各位大神了，激动的心，颤抖的手，提前给各位大佬敬杯酒，祝各位大佬猪年吉祥，万事如意，升官发财，步步高升！！！！