ms-access - 出现错误：对象 'TableDefs' 的方法 'Append' 失败 (-214741848)

Question

刚刚升级到 Windows 10 Pro 并使用 Office 2016 .. 当我尝试运行以前在 Office 2016 上使用 Windows 7 Pro 运行的 VBA 脚本时，我得到一个弹出框：

对此的任何帮助将不胜感激。

Private Sub Connect_Click()

Dim strConnect As String
Dim DSNCombo As String

DSNCombo = [Forms]![frm DB Selection]![Combo2]
CboYear = Right(DSNCombo, 4)
strConnect = "ODBC;Driver={Pervasive ODBC Interface};ServerDSN=" & DSNCombo & ";ServerName=myserver;UID=myuid;PWD=mypassword"
On Error GoTo Err_FixConnections

'Dim dbCurrent As DAO.Database
'Dim tdfCurrent As DAO.TableDef

Set dbCurrent = DBEngine.Workspaces(0).Databases(0)


Set MyTbls = dbCurrent.OpenRecordset("tblTableNames")

NumRecs% = 0

MyTbls.MoveFirst
Do While Not MyTbls.EOF
    TblSource$ = MyTbls![SourceTableName]
    TblCreate$ = MyTbls![CreateTableDef]
    TblSelect% = MyTbls![Select]

    NumRecs% = NumRecs% + 1


    DoCmd.DeleteObject acTable, TblCreate$
    DoCmd.DeleteObject acTable, TblCreate$ & CboYear

    If TblSelect% = True Then

        If CheckYear = True Then

            Set tdfCurrent = dbCurrent.CreateTableDef(TblCreate$ & CboYear)

        Else

            Set tdfCurrent = dbCurrent.CreateTableDef(TblCreate$)

        End If


        tdfCurrent.Connect = strConnect
        tdfCurrent.SourceTableName = TblSource$
        dbCurrent.TableDefs.Append tdfCurrent

    End If

    MyTbls.MoveNext

Loop
MyTbls.Close

End_FixConnections:
On Error Resume Next
Set tdfCurrent = Nothing
Set dbCurrent = Nothing

DoCmd.Beep
Exit Sub

Err_FixConnections:
Select Case Err.Number
    Case 7874  'Table Not Found
        Resume Next
    Case Else
        MsgBox Err.Description & " (" & Err.Number & ") encountered", _
        vbOKOnly + vbCritical, "Fix Connections"
        Resume End_FixConnections
End Select

End Sub