Access password gets deleted

[DrewDog_21]

I'm fairly sure that Microsoft hates me. Why else would I
have this silly little problem that is giving me so many
headaches? I use the following code (i found this example
here on these boards) to compact an Access 2000 database.
But it DELETES THE M.F*ING PASSWORD :mad:! I have the user
enter the password in a textbox and pass it in as a
variable. It works to open the database but does not copy
the password to the newly compacted database. ¿¿WHY??


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


[Edited by DrewDog_21 on 09-21-2000 at 07:20 PM]