ms-access - 取得エラー: オブジェクト 'TableDefs' のメソッド 'Append' が失敗しました (-214741848)

Question

Windows 10 Pro にアップグレードし、Office 2016 を使用しています。以前は Windows 7 Pro を使用して Office 2016 で動作していた 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