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