Ciao redbluewolves,
la routine che chiedi è un po’ lunghetta; comunque dato che ho un po’ di tempo disponibile l’ho scritta.
In una Frm chiamata frmLogin inserisci due Txt dal Nome: TxtApriUN e TxtApriPW e due CmdButton dal Nome: cmdOK e cmdCancel. Nel progetto di prova inserisci anche una Form dal Nome FrmProva, che ti servirà per provare l’apertura del programma.
Nel modulo della frmLogin inserisci:
codice:
Option Explicit
' Annulla Esce dall'applicazione:
Public OK As Boolean
Private Sub Form_Load()
    With frmLogin
        .WindowState = vbNormal
        .Top = 3045
        .Height = 2475
        .Width = 4920
    End With
End Sub
' E' stato premuto Annulla:
Private Sub cmdCancel_Click()
    OK = False
    Me.Hide
End Sub
'Verifica la validità della password e dell'UserName:
Private Sub cmdOK_Click()
    
On Error GoTo ErrHandler
    
    Dim ConSR As New ADODB.Connection
    Dim RSTctr As New ADODB.Recordset
    
    Dim sPassWord As String
    
    Dim sVpassW As String
    Dim sVUName As String
    Dim vRegNomeComp As Variant
    Dim vRegNomeUser As Variant
    Dim user As Boolean
    
    user = False
      
'Acquisisce il Nome dell'Utente-Funzione nel Modulo:
    Dim sBuffer As String
    Dim lSize As Long

    sBuffer = Space$(255)
    lSize = Len(sBuffer)
    Call GetUserName(sBuffer, lSize)
    
    If lSize > 0 And Len(TxtApriUN.Text) = 0 Then
        TxtApriUN.Text = Left$(sBuffer, lSize)
    ElseIf lSize = 0 And Len(TxtApriUN.Text) = 0 Then
        TxtApriUN.Text = "admin"
    End If
      
' Acquisisce la pw e username digitati:
    sPassWord = TxtApriPW.Text
    sUName = TxtApriUN.Text
     
    'Esegue la connessione con il DataBase:
        With ConSR
            .ConnectionString = DataConnessione
            .CursorLocation = adUseClient   'tipo di cursore
            .Mode = adModeShareDenyNone     'nessuna limitazione
            .CommandTimeout = 15
            .Open
       End With
       
  ' Controlla se la PassWord è presente nel DB:
        RSTctr.Source = "SELECT UsernameX, PasswordX FROM TblPW WHERE UsernameX ='" & sUName & "' And PasswordX='" & sPassWord & "'"
        RSTctr.Open , ConSR

    Do Until (RSTctr.EOF)
        If sUName = RSTctr("UsernameX") And sPassWord = RSTctr("PasswordX") Then
            vRegNomeComp = StrComp(RSTctr("PasswordX"), sPassWord, vbTextCompare)
            vRegNomeUser = StrComp(RSTctr("UsernameX"), sUName, vbTextCompare)
            ' La PW è uguale Apre il file:
            If vRegNomeComp = 0 And vRegNomeUser = 0 Then
                sngNuV = 0
                Me.Hide
                OK = True
                user = True
            End If
            Exit Do
            Else
            user = False
        End If
        RSTctr.MoveNext
    Loop
        
    'La password o il nome utente sono errati:
    If user = False Then
        sngNuV = 1 + sngNuV
        MsgBox "La PassWord o il Nome utente non è corretto! Riprovare." & Chr(13) _
        & "Prove effettuate  " & sngNuV & "  di  4." & Chr(13) _
        & "Attenzione, alla 4^  prova il programma verrà chiuso!", vbCritical, "Prova PW"
                TxtApriPW.SetFocus
                TxtApriPW.SelStart = 0
                TxtApriPW.SelLength = Len(TxtApriPW.Text)
                If sngNuV > 3 Then
                    MsgBox "E' stata introdotta per quattro volte una PassWord non è corretta !" & Chr(13) _
                    & "Il programma verrà chiuso.", vbCritical, "Prova PW"
                    Unload frmLogin
                    Set frmLogin = Nothing
                    End
                End If
            End If
    
        
    'Chiude e cancella il recordSet:
        If GetState(RSTctr.State) = "adStateOpen" Then
            RSTctr.Close
            Set RSTctr = Nothing
        End If
    'Chiude la connessione - TblPW:
        If GetState(ConSR.State) = "adStateOpen" Then
            ConSR.Close
            Set ConSR = Nothing
        End If

ErrHandler:
    If Err.Number <> 0 Then
        MsgBox "Errore: " & Err.Number & " " & Err.Description & Chr(13) _
        & "Errore nella ricerca della password o del Nome utente." & Chr(13) _
        & "Inserire una Password/Nome utente corretti.", vbCritical, "Prova PW"
        Err.Clear
        'Chiude e cancella il recordSet:
        If GetState(RSTctr.State) = "adStateOpen" Then
            RSTctr.Close
            Set RSTctr = Nothing
        End If
        'Verifica e Chiude la connessione - TblPW:
        If GetState(ConSR.State) = "adStateOpen" Then
            ConSR.Close
            Set ConSR = Nothing
        End If
        Exit Sub
    End If
End Sub
'Verifica lo stato della connessione:
Public Function GetState(intState As Integer) As String
    Select Case intState
        Case adStateClosed
            GetState = "adStateClosed"
        Case adStateOpen
            GetState = "adStateOpen"
    End Select
End Function
In un modulo .bas inserisci:
codice:
Public DataConnessione As String
' Acquisisce il Nome dell'Utente:
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
' Acquisisce l'UserName all'apertura del file:
Public sUName As String
' Conta quante volte la pw è errata:
Public sngNuV As Single
' Sub d'avvio del programma:
Sub Main()
    
    Call DataConnessione2

    frmLogin.Show vbModal
    If Not frmLogin.OK Then
        'L'accesso non è riuscito, esce dall'applicazione:
        End
    End If
    ' Chiude la frmLogin:
    Unload frmLogin
    Set frmLogin = Nothing

    ' Apre la 1^ Frm del programma:
    FrmProva.Show

End Sub
' Connessione con il DB:
Public Sub DataConnessione2()
    On Error GoTo ErrHandler

' Stringa di connessione Con password:
    DataConnessione = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\ProvaPW.mdb;Persist Security Info=False;Jet OLEDB:Database Password=LMONDI;"

ErrHandler:
If Err.Number <> 0 Then
    MsgBox "Errore: " & Err.Number & " " & Err.Description & Chr(13) _
    & "Errore  nella connessione al Data Base." & Chr(13) _
    & "Riavviare il programma.", vbCritical, "Prova PW"
    Err.Clear
    Exit Sub
End If

End Sub
La routine è funzionante, dato che l'ho provata e certamente può essere migliorata.
PS. il DataBase utilizzato nell'esempio è ACCESS.