Compactar e Repara

Amigos bom dia !!!

Estou copiei um módulo do Maestro de nosso Amigo Avelino.

É aquele que compacta e repara, o certo.

Então o que acontece é que ao clicar no menu ele compacta e fecha o programa, no Maestro ele compacta e chama o frLogin.

O que será fiz de errado??

Se alguém puder me ajudar eu agradeço.

Vou colocar o código em baixo pra vocês analisarem.

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