OK,pensavo fosse colpa di qualche mio errore e con una tua analisi riuscivi a trovare il problema.Cmq l'errore si verifica dove evidenziato nel codice e mi dice:
codice:
Errore di run-time '3705':
L'operazione non è consentita se l'oggetto è aperto.
Qeusto è il codice per intero.
codice:
Option Explicit
Public Function ControlloPassword(ByRef adoCN As ADODB.Connection, ByVal sPathMDB As String, Optional ByVal sPasswordDB As String = "") As Boolean
Dim sqlExecStr As String
Dim iOldMode As ADODB.ConnectModeEnum
Dim sConnectionString As String
Dim sOldpassword As String
Dim sNewPassword As String
Dim bOnTransaction As Boolean
On Error GoTo ERR_HANDLER
Rem ------------------------------------------------------------
Rem La connessione è già aperta, verifico se è esclusiva
Rem ------------------------------------------------------------
If Not adoCN Is Nothing Then
iOldMode = adoCN.Mode ' annoto la modalità precedente
If adoCN.Mode <> adModeShareExclusive Then
adoCN.Close ' chiudo la connessione
End If
End If
Rem ------------------------------------------------------------
Rem Se il cursore non è Server chiudo la connessione, se è aperta
Rem ------------------------------------------------------------
If Not adoCN Is Nothing Then
If adoCN.CursorLocation <> adUseServer Then
If adoCN.State = adStateOpen Then
adoCN.Close
End If
End If
End If
Rem ------------------------------------------------------------
Rem Riapro la connessione in modalità esclusiva e lato Server
Rem per poter usare una trasazione nel caso di errori.
Rem ------------------------------------------------------------
sPathMDB = App.path & "\" & "database.mdb"
With adoCN
.CursorLocation = adUseServer
.Mode = adModeShareExclusive
.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sPathMDB '& ";;Jet OLEDBatabase Password=" & sPasswordDB
.BeginTrans
GoTo APRI
Exit Function
.CommitTrans
bOnTransaction = False
.Close
End With
Exit Function
Rem ------------------------------------------------------------
APRI:
If MsgBox("Nessuna password impostata.Vuoi Impostarla adesso?", vbYesNo, "Impostazione Password") = vbYes Then
sNewPassword = InputBox("Inserisci la nuova password:", "Password")
AddDBPassword CN, sPathMDB, sNewPassword
Else
MsgBox "Sarà per la prossima volta!!", vbOKOnly, "Impostazione Password"
End If
ERR_HANDLER:
If Err.Number = -2147217843 Then
If MsgBox("Password già impostata!!Vuoi modificarla?", vbYesNo, "Controllo Password:") = vbYes Then
sOldpassword = InputBox("Inserisci la vecchia password:", "Password")
sNewPassword = InputBox("Inserisci la nuova password:", "Password")
ChangeDBPassword CN, sPathMDB, sOldpassword, sNewPassword
Else
MsgBox "La potrai impostare quando vorrai!"
Exit Function
End If
End If
If Err.Number = 3705 Then
' adoCN.Close
' ControlloPassword CN, sPathMDB, sPasswordDB
End If
Exit Function
End Function
Avevo provato a chiuderlo direttamente ma mi dice che durante una transazione di dati non si può chiudere.Come posso risolvere?Grazie
Rispondi quotando
