Newsgroup: it.comp.appl.access
Titolo: compattare mdb protetto

Buon giorno a tutto il NG volevo chiedervi se era possibile aggiungere
al seguente codice, il comando che mi permetta di compattare il
database dove sono le tabelle con i dati protetto da password.
Grazie 
Michele
Option Compare Database
Option Explicit
Dim fermaBackup As Boolean
Dim nomeBackEnd As String
Dim nomeFrontEnd As String
Function creaBackupDB()
Dim riga(1 To 12) As String
Dim fileLDB As String
Dim confermaMsg As String
On Error GoTo Err_creaBackupDB
confermaMsg = "Il database verrà chiuso e verrà effettuata una copia
di backup" & vbCrLf & _
              "sia dei dati residenti sul server che dell'applicazione
locale." & vbCrLf & _
              "Prima di proseguire accertarsi che nessun altro utente
abbia il" & vbCrLf & _
              "database aperto. " & vbCrLf & _
              "Vuoi continuare?"
If Conferma(confermaMsg) Then
chiudiTutto
fermaBackup = False
nomeBackEnd = "nessuno"
CompattaBE
If fermaBackup = True Then Exit Function
If Dir(PathCorrente & "creaBackup.vbs") = "creaBackup.vbs" Then
Kill PathCorrente & "creaBackup.vbs"
End If
fileLDB = Left(CurrentDb.name, Len(CurrentDb.name) - 3)
    riga(1) = "Dim fso, file1"
    riga(2) = "Set fso = CreateObject(""Scripting.FileSystemObject"")"
    riga(3) = "Do While fso.FileExists(""" & fileLDB & "ldb"")"
    riga(4) = "Loop"
    riga(5) = "if fso.FileExists(""" & nomeFrontEnd & """) Then"
    riga(6) = "fso.DeleteFile(""" & nomeFrontEnd & """)"
    riga(7) = "End if"
    riga(8) = "Set file1 = fso.GetFile(""" & CurrentDb.name & """)"
    riga(9) = "file1.Copy(""" & nomeFrontEnd & """)"
    riga(10) = "msgbox ""Nome BE: " & nomeBackEnd & """ & vbCrLf &
""Nome FE: " & nomeFrontEnd & """"
    riga(11) = "Set file1 = Nothing"
    riga(12) = "Set fso = Nothing"
 
    Open PathCorrente & "creaBackup.vbs" For Output As #1
        Print #1, riga(1)
        Print #1, riga(2)
        Print #1, riga(3)
        Print #1, riga(4)
        Print #1, riga(5)
        Print #1, riga(6)
        Print #1, riga(7)
        Print #1, riga(8)
        Print #1, riga(9)
        'Print #1, riga(10)
        Print #1, riga(11)
        Print #1, riga(12)
        Close #1
        Shell "WSCRIPT.exe " & PathCorrente & "creaBackup.vbs",
vbNormalFocus
        DoCmd.Quit
End If
Exit_creaBackupDB:
    Exit Function
Err_creaBackupDB:
    MsgBox Err.Description
    Resume Exit_creaBackupDB
End Function
Sub CompattaBE()
Dim Data, g, m, a, s, b, gds, Giorno
Dim backend As String
Dim strSQL As String
Dim rs As Recordset
Dim risp As Integer
Dim COPIA As String
On Error GoTo gestErr
Data = Format(Date, "dd/mm/yy")
g = Left(Data, 2)
m = Mid(Data, 4, 2)
a = "20" + right(Data, 2)
If m < 3 Then
  m = m + 12: b = a - 1
Else
  b = a
End If
s = g + 2 * m + Int(3 * (m + 1) / 5) + b + Int(b / 4) + 5
If b > 1582 Then s = s - Int(b / 100) + Int(b / 400) + 2
gds = s Mod 7
If gds = 0 Then Giorno = "Lunedi"
If gds = 1 Then Giorno = "Martedi"
If gds = 2 Then Giorno = "Mercoledi"
If gds = 3 Then Giorno = "Giovedi"
If gds = 4 Then Giorno = "Venerdi"
If gds = 5 Then Giorno = "Sabato"
If gds = 6 Then Giorno = "Domenica"
 
nomeFrontEnd = CurrentDb.name & Giorno & ".bak"
   strSQL = "SELECT Trim([Database]) AS DB " & _
            "FROM MSysObjects " & _
            "GROUP BY Trim([Database]), MSysObjects.Type " & _
            "HAVING (((MSysObjects.Type)=6));"
   Set rs = CurrentDb.OpenRecordset(strSQL)
   If rs.EOF And rs.BOF Then GoTo Esci
   DoCmd.Hourglass True
   DoCmd.SetWarnings False
       backend = rs![DB]
       DBEngine.CompactDatabase backend, backend & ".new"
       COPIA = Dir(backend & Giorno & ".bak")
       If COPIA <> "" Then Kill backend & Giorno & ".bak"
       Name backend As backend & Giorno & ".bak"
       Name backend & ".new" As backend
       nomeBackEnd = backend & Giorno & ".bak"
Esci:
   rs.Close
   Set rs = Nothing
   DoCmd.SetWarnings True
   DoCmd.Hourglass False
   Exit Sub
gestErr:
   If Err.Number = 3356 Then
   visualizzaMessaggio "Qualche utente è collegato al database sul
server." & vbCrLf & _
                       "Far scollegare gli utenti collegati e
rieseguire " & vbCrLf & _
                       "la procedura di backup."
   fermaBackup = True
   Else
   MsgBox Err.Number & " - " & Err.Description
   End If
   GoTo Esci
End Sub

    visualizzaMessaggio "Qualche utente č collegato al database sul


 > End Sub
Ho provato a inserire la password all'interno della seguente riga del codice
DBEngine.CompactDatabase backend, backend & ".new", , , "password"
inserendola e mandando in esecuzione il backup mi dail seguente errore
errore 3170 - impossibile trovare ISAM instabile
qualcuno di voi è in grado di risolvermi tale impiccio.
Michele

 Michele
problema identico!!!
ho letto che tutti hanno avuto lo stesso problema, ma non sono mai
riuscita a trovare la soluzione