Erro quando tento adicionar banco .accdb

Estou com um problema, tento mudar o banco de dados e ele aparece o problema que enviarei no anexo. Por favor, se puder me ajudar agradecerei!


OBS: Ele funciona normalmente com arquivos .mdb mas devido a segurança preciso usar um .accdb ou semelhante e sempre fica dando o mesmo erro. Se alguém souber como contornar o problema ou o erro desse código por favor. Agradeço!




Dim BD As Database
Dim TB(2) As Recordset
Dim Linha As Long

Private Sub lbtTexto_Click()

End Sub

Private Sub UserForm_Activate()

DADOS = EstaPasta_de_trabalho.Path & CAMINHO

Set BD = OpenDatabase(DADOS)
Set TB(0) = BD.OpenRecordset("Ordenar_BD_Neoc", dbOpenTable)
TB(0).Index = "CONTRATO"


Menssagem ("Abrindo Base de dados...")
'Busca pelo medidor
If Plan1.opMedidor.Value = True Then
Menssagem ("Localizando contrato pelo medidor...")
Set TB(1) = BD.OpenRecordset("SELECT * FROM [Ordenar_BD_Neoc] WHERE [EQUIPAMENTO] = '" & Plan1.Cells(5, 7) & "'", 2)
If Not TB(1).EOF Then TB(1).MoveLast
If TB(1).RecordCount = 0 Then
Menssagem ("Medidor não localizado...")
Unload Me
Exit Sub
ElseIf TB(1).RecordCount = 1 Then
Menssagem ("Contrato localizado: " & CStr(TB(1)("Contrato").Value))
CONTRATO = TB(1)("Contrato").Value
Else
TB(1).MoveFirst
UserForm1.ListBox1.Clear
Do While Not (TB(1).EOF)
UserForm1.ListBox1.AddItem TB(1)("Contrato")
TB(1).MoveNext
Loop
UserForm1.ListBox1.ListIndex = 0
UserForm1.Show 1
End If
Else
CONTRATO = CStr(Format(E_contrato(Plan1.Cells(5, 7)), "0000000000"))
End If

Menssagem ("Localizando a rota e o roteiro do contrato...")
TB(0).Seek "=", CONTRATO
If TB(0).NoMatch Then
Menssagem ("Rota e roteiro não localizados...")
Else
Menssagem ("OK, localizado: Rota " & CStr(TB(0)("Rota").Value) & " Roteiro " & CStr(TB(0)("Roteiro").Value))
Plan1.Cells(4, 7) = TB(0)("CGL").Value
Plan1.Cells(3, 12) = TB(0)("CGL").Value
Plan1.Cells(6, 3) = TB(0)("Rota").Value
Plan1.Cells(6, 7) = TB(0)("Roteiro").Value
Plan1.Cells(6, 13) = TB(0)("Propriedade").Value
Plan1.Cells(6, 19) = TB(0)("Poste").Value
Plan1.Cells(6, 24) = TB(0)("Posto").Value
Menssagem ("Localizando o contrato em: Rota " & CStr(TB(0)("Rota").Value) & " Roteiro " & CStr(TB(0)("Roteiro").Value))
Set TB(1) = BD.OpenRecordset("SELECT * FROM [Ordenar_BD_Neoc] WHERE [Rota] = " & Plan1.Cells(6, 3) & _
" AND [Roteiro] = " & Plan1.Cells(6, 7) & " ORDER BY [ROTA], Ordenar_BD_Neoc.[ROTEIRO],[PROPRIEDADE]", 2)
If TB(1).RecordCount > 0 Then
TB(1).FindFirst ("Contrato = " & CONTRATO & "")
Plan1.Cells(6, 13) = TB(1)("Propriedade").Value
Linha = 22
For i = 1 To 13
TB(1).MovePrevious
If TB(1).BOF Then
TB(1).MoveNext
Exit For
End If
Linha = Linha - 1
Next
For i = Linha To 35
Preenche_Linha
Linha = Linha + 1
TB(1).MoveNext
If TB(1).EOF Then
Exit For
End If
Next
End If
End If


'Fecha o formulário
Unload Me

End Sub

Sub Menssagem(MS As String)

Me.lbtTexto.Caption = Me.lbtTexto.Caption & Chr(13) & MS
Me.Repaint


End Sub

Sub Preenche_Linha()

Plan1.Cells(Linha, 1) = Trim(TB(1)("CONTRATO"))
Plan1.Cells(Linha, 4) = Trim(TB(1)("EQUIPAMENTO"))
Plan1.Cells(Linha, 7) = Trim(TB(1)("POSTO")) & " - " & Trim(TB(1)("NOME"))
Plan1.Cells(Linha, 13) = Trim(TB(1)("VIA")) & " " & Trim(TB(1)("CALLE"))
Plan1.Cells(Linha, 21) = Trim(TB(1)("PORTAL")) & " " & Trim(TB(1)("COD_BIS")) & "," & Trim(TB(1)("TIP_ESCALERA")) & " " & Trim(TB(1)("TIP_MANO"))
Plan1.Cells(Linha, 23) = Trim(TB(1)("BAIRRO"))
Plan1.Cells(Linha, 26) = Trim(TB(1)("PROPRIEDADE"))


End Sub