[Resolvido]Compactar Back End com senha

Tentei usar esta função de JPaulo para compactar um BE com senha do access 2007, mas da a sequinte
mensagem "Senha invalida" Tem como inserir a senha nesta função para isto ser possivel.

Obrigado pela atenção.



Function CompactaBE()
'By JPaulo @ 2009

On Error GoTo Err_CompactaBE
Dim stFileName As String
DoCmd.Hourglass True
stFileName = "c:\teste.accdb"
DBEngine.CompactDatabase stFileName, stFileName & "TMP"

If Dir(stFileName & ".BCK") <> "" Then _
Kill stFileName & ".BCK"
Name stFileName As stFileName & ".BCK"
Name stFileName & "TMP" As stFileName
If Dir(stFileName & "TMP") <> "" Then _
Kill stFileName & "TMP"


CompactaBE = True

Exit_CompactaBE:
DoCmd.Hourglass False
Exit Function

Err_CompactaBE:
DoCmd.Hourglass False
CompactaBE = False
If Err.Number = 3356 Then
MsgBox "Banco em Uso..."
Else
MsgBox Err.Description
End If
Resume Exit_CompactaBE
End Function

Amigão, dê uma estudada nesse código do grande Vieira e veja se consegues adaptar:

Public Function compactaDB(ByVal origem_path As String, _
ByVal destino_path As String) As Boolean

On Error GoTo Erro_compacta

Dim DB_origem As String, DB_destino As String
Dim JRO As JRO.JetEngine
Set JRO = New JRO.JetEngine

DoEvents
DB_origem = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & origem_path & ";Jet OLEDB:Database Password=merc290901;"
DB_destino = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & destino_path & " ;Jet OLEDB:Database Password=merc290901;Engine Type=5"

JRO.CompactDatabase DB_origem, DB_destino

compactaDB = True
Exit Function

Erro_compacta:
compactaDB = False
MsgBox Err.Description, vbExclamation
End Function

Obrigado pela dica vou tentar adaptar depois retorno.

Apos algum tempo consequi.......
Adaptado de outro codigo
No evento ao clicar de um botão

Dim objFSO As Object
Dim objEngine As Object
Dim strLckFile As String
Dim strSrcName As String
Dim strDstName As String
Dim strPassword As Variant
'para fechar os forms menos o form principal
Dim obj As Object
Dim strName As String

If MsgBox("Compactar e Reparar Banco de dados?", vbQuestion + vbYesNo, "Manutenção") = vbNo Then
DoCmd.Close
Exit Sub
Else

For Each obj In Application.CurrentProject.AllForms
If obj.Name <> "frmFundoTela" Then
DoCmd.Close acForm, obj.Name, acSaveYes
End If
Next obj

End If
''''''''''''''''''''''''''''''''''''''''''''
'Carrega as variaveis
'strLckBE = CurrentProject.Path & "\Banco_be.laccdb" ' se esta m uso
strBe = CurrentProject.Path & "\Banco_be.accdb" 'original
strNovoBE = CurrentProject.Path & "\NFCompactado.accdb" 'arquivo temporario
strBackup = CurrentProject.Path & "\Banco_beAC.Maccdb" 'remover o AC e o M para ativar o Backup
strPassword = "SuaSenha" 'senha do BE 'caso de erro na compactação

Set objEngine = CreateObject("DAO.DBEngine.120")

Set objFSO = CreateObject("Scripting.FileSystemObject")
'Desativado,caso o programa travar este arquivo não é deletado
'If (objFSO.FileExists(strLckBE)) Then 'confere se o BackEnd não está em uso ...
'MsgBox "Programa com formulario aberto", vbCritical, "Fechar os formularios"
'Exit Sub
'Else
' se existir um backup antigo,de um compactação anterior ...
If (objFSO.FileExists(strBackup)) Then
objFSO.DeleteFile strBackup
End If
'se exitir um arquivo compactado antigo...
If (objFSO.FileExists(strNovoBE)) Then
objFSO.DeleteFile strNovoBE
End If
'Verifica se o EnergiaNF_be esta na pasta do banco de dados
If (objFSO.FileExists(strBe)) Then
objFSO.CopyFile strBe, strBackup ' copia o BE a ser compactado
Else
MsgBox "Banco_be não encontrado na pasta do Banco de dados", vbCritical, "Atenção"
Exit Sub
End If

'verifica se fez uma nova copia do BE antes de compactar
If (objFSO.FileExists(strBackup)) = True Then
Else
MsgBox "Erro na copia do arquivo para Backup. Compactação Cancelada....", vbCritical, "Atenção"
Exit Sub
End If

''dbVersion120 = 128
objEngine.CompactDatabase strBe, strNovoBE, , 128, ";pwd=" & strPassword

objFSO.DeleteFile strBe ' deleta o BE que está sendo compactado
objFSO.MoveFile strNovoBE, strBe 'Renomeia o BE compactado com o nome original
MsgBox "Compactado com sucesso.....", vbInformation, "Manutenção"
'End If
'reabre o formulario para novo login
DoCmd.OpenForm "frmLogin"


Fonte do arquivo original
http://comunidade.itlab.com.br/eve/forums/a/tpc/f/273606921/m/2007004143

Espero ter ajudado e não só esperar ajuda.......