Access password gets deleted -

Private Sub cmdCompactar_Click()

On Error GoTo Database_Error

Dim objJRO As JRO.JetEngine
Dim strDBSource As String, strDBDestination As String
Dim strConnSource As String, strConnDestination As String
Dim fsObject As Variant
Dim i As Single

strDBSource = txtDatabase

If strDBSource = "" Then
    MsgBox "Debe seleccionar un base de datos antes de continuar.", vbExclamation
    cmdDatabase_Click
    Exit Sub
ElseIf Dir(strDBSource) = "" Then
    MsgBox "La ruta de acesso está invalido.", vbCritical
    txtDatabase = ""
    cmdDatabase.SetFocus
    Exit Sub
End If

If MsgBox("Está a punto a compactar el base de datos" & Chr(13) & Chr(10) & _
  Chr(13) & Chr(10) & strDBSource & Chr(13) & Chr(10) & _
  Chr(13) & Chr(10) & "Antes de continuar, debe cerrar todos los " & Chr(13) & Chr(10) & _
  "applicaciones que están utalizando este " & Chr(13) & Chr(10) & _
  "base de datos.  ¿Desea continuar?", vbYesNo) = vbNo Then
  
    Exit Sub
    
End If

Me.MousePointer = vbHourglass
DoEvents

Set fsObject = CreateObject("Scripting.FileSystemObject")

strDBDestination = fsObject.GetParentFolderName(strDBSource) & "\db1.mdb"

i = 2
Do Until Dir(strDBDestination) = ""
    strDBDestination = fsObject.GetParentFolderName(strDBSource) & "\db" & i & ".mdb"
Loop

strConnSource = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBSource & ";Jet OLEDB:Database Password=" & txtClave
strConnDestination = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBDestination

'instantiate object
Set objJRO = Nothing
Set objJRO = New JRO.JetEngine

'compact database from source to destination
objJRO.CompactDatabase strConnSource, strConnDestination

'release objects
Set objJRO = Nothing
Set fsObject = Nothing

Kill strDBSource
Name strDBDestination As txtDatabase

Me.MousePointer = vbDefault
DoEvents

MsgBox "El base de datos ha sido compactado con éxito.", vbInformation

Exit Sub

Database_Error:
    Me.MousePointer = vbDefault
    DoEvents

    'release objects
    Set objJRO = Nothing
    Set fsObject = Nothing

    Select Case Err.Number
        Case -2147217843 'bad password
            MsgBox "Clave inválido", vbExclamation
            If chkClave.Value = vbChecked Then
                txtClave.SetFocus
            Else
                chkClave.Value = vbChecked
            End If
        
        Case Else
            MsgBox "Error en base de datos." & Chr(13) & Chr(10) & _
              Chr(13) & Chr(10) & Err.Description, vbCritical

            txtDatabase = ""
            cmdCompactar.Enabled = False
            cmdDatabase.SetFocus
    
            If Dir(strDBDestination) <> "" Then Kill strDBDestination
    
    End Select
      
End Sub