[Resolvido]Erro: 3061 Parâmetros Insuficientes. Eram esperados 1

Olá minha gente,

Tenho um problema a vários dias com o erro "Erro: 3061 Parâmetros Insuficientes. Eram esperados 1". O erro acontece quando o usuário esta entrando no sistema, ainda na tela de login. Não sei como resolver, já modifiquei o código trocando o comando CurrentDb.Execute pelo Docmd.RunSQL. Liberei todas as macros na central de confiabilidade do access 2010. Adicionei o local como confiável, enfim não consigo resolver o problema. Peço ajuda de qualquer alma que possa me estender a mão. Sou iniciante no VBA. Abaixo consta um link com o arquivo para download e um vídeo explicando o problema no código. O erro somente aparece quando eu executo a macro. Também já depurei e compilei o código e não apresenta qualquer falha.Abaixo consta o código que esta vinculado a macro. A senha do back end é a1234. A senha do front end: Usuario: admin e senha:admin

https://1drv.ms/f/s!AgHCWa12NNUWpzNORy6Rip7h5ADf

Código:


Option Compare Database
Option Explicit
Public CaminhoAtual     As String
Public booNovaChecagem  As Boolean
Public booOk            As Boolean
Public booSair          As Boolean

Public Function fncChecaVinculo() As Boolean
Dim PathBe    As String
Dim NomeBE    As String
Dim Contador  As Byte
Dim box       As String

On Error GoTo trataerro

'If InStr(Right(CurrentDb.Name, 6), ".accdr") = 0 Then
    'fncChecaVinculo = True
    'Exit Function
'End If

PathBe = Nz(DLookup("path_0", "tblCaminhoBe"), "vazio")
NomeBE = Nz(DLookup("NomeBe", "tblCaminhoBe"), "vazio")

'---------------------------------------------------------------------------
'Verifica se o caminho atual do back-end esta gravado na tabela tblCaminhoBe
'---------------------------------------------------------------------------
If PathBe = "vazio" Then
    PathBe = CurrentProject.Path & "\" & NomeBE
    CurrentDb.Execute "UPDATE tblcaminhoBe SET path_0 ='" & PathBe & "'"
End If

CaminhoAtual = fncBackEndAtual

If Not fncFalhaConexaoBE(PathBe) Then
    If (CaminhoAtual <> PathBe) Then
        CaminhoAtual = PathBe
        DoCmd.ShowToolbar "ribbon", acToolbarNo
        DoCmd.OpenForm "frmBarraProgresso", OpenArgs:=1
    Else
        Application.SetOption "Auto Compact", False
        If Len(Trim(DLookup("formPrincipal", "tblCaminhoBe")) & "") > 0 Then
            DoCmd.OpenForm DLookup("formPrincipal", "tblCaminhoBe")
        End If
        DoCmd.ShowToolbar "ribbon", acToolbarYes
        Call fncCarregaRibbon
    End If
Else
    DoCmd.ShowToolbar "ribbon", acToolbarNo
    DoCmd.OpenForm "frmCaminhoBe", , , , , acDialog, 1
    If booSair Then
        fncChecaVinculo = True
        Exit Function
    End If
    If booNovaChecagem Then fncChecaVinculo
End If

sair:
    Exit Function
trataerro:
    Select Case Err.Number
        Case 76, 52
            DoCmd.OpenForm "frmCaminhoBe", , , , , acDialog, 1
            If booSair Then
                fncChecaVinculo = True
                Exit Function
            End If
            If booNovaChecagem Then fncChecaVinculo
        Case 2102
            MsgBox "O formulário principal '" & DLookup("formPrincipal", "tblCaminhoBe") & "' não existe...", vbInformation, "Aviso"
        Case Else
            MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
            fncChecaVinculo = True
        End Select
End Function

Public Function fncBackEndAtual() As String
Dim strCon As String
Dim strTabelaLink As String
Dim tbl As DAO.TableDef
Dim k
On Error GoTo trataerro

For Each tbl In CurrentDb.TableDefs
    If Len(tbl.Connect & "") > 0 Then strTabelaLink = tbl.Name
Next
'-----------------------------------------------------
'Vou usar a última tabela vinculada, para obter
'o caminho do back-end (propriedade Connect).
'-----------------------------------------------------
strCon = CurrentDb.TableDefs(strTabelaLink).Connect
'-----------------------------------------------------
'Agora vou retirar apenas o caminho do accdb,
'sem o ";DATABASE=" que o precede na string Connect.
'-----------------------------------------------------
fncBackEndAtual = Right$(strCon, (Len(strCon) - (InStr(1, strCon, ";DATABASE=", 2) + 9)))

sair:
    Exit Function
trataerro:
    MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
    Resume sair:
End Function

Public Function fncFalhaConexaoBE(strLocalBe As String) As Boolean
Dim bd As DAO.Database
On Error Resume Next
If Len(fncCrip(DLookup("senha", "tblCaminhoBe"), 102030) & "") = 0 Then
    'Abrir BE sem senha
    Set bd = OpenDatabase(strLocalBe, False, False)
Else
    'abrir BE com senha
    Set bd = OpenDatabase(strLocalBe, False, False, ";PWD=" & fncCrip(DLookup("senha", "tblCaminhoBe"), 102030))
End If
If Err Then
    Err.Clear
    fncFalhaConexaoBE = True
Else
    bd.Close
    fncFalhaConexaoBE = False
End If
Set bd = Nothing
End Function

Public Function fncCrip(strTexto As String, Optional chave As Long = 0)
Dim j As Integer, R As String
If chave <> 102030 Then Exit Function
For j = 1 To Len(strTexto)
    R = R & Chr((Asc(Mid(strTexto, j, 1)) Xor 36))
Next j
fncCrip = R
End Function




Olá gente,

Ninguém aqui passou um problema semelhante? Agradeço qualquer ajuda, pois ainda não consegui resolver. Como disse no poster anterior já tentei de tudo e nada. Peço alguma dica, qualquer que seja.

Boa noite Gente,

Peço desculpas pela insistência, mas estou tentando desde de domingo resolver o problema e até agora não encontrei nem mesmo aonde esta o problema. Acredito que alguém em algum momento vivenciou algo semelhante. Agradeço qualquer dica ou ajuda.

Grato,

Bom dia a todos,

Agradeço ao Professor Avelino que ajudou - me na solução do problema. No intuito de ajudar a outras pessoas, abaixo consta a solução enviada pelo professor Avelino.

" Retira a indicação do formulário de login, lá das Opções do Access > banco de dados Atual > Formulário de Exibição. A função checaVinculos é a responsável pelo carregamento do formulário de login
2- Abra o módulo mod_checaVinculos e retire a linha Call fncCarregaRibbon Esta linha é responsável pelo carregamento das ribbons da tabela tblRibbons. Como vc usa a tabela UsysRibbons, esse comando acarretou o erro na inicialização."


Grato a Todos mais principalmente ao Professor Avelino.

Olá, obrigado pelo retorno.
Não vi que já tinha respondido e tinha verificado que estava aí o erro.
Abraço