-
Microsoft Hates Me!!
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??
Code:
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]
