Msgbox Application.CurrentUser

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSUserName() As String
 ' Retourne le nom d'usager fourni lors du branchement au réseau.
Dim lngLen As Long, lngX As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngX = apiGetUserName(strUserName, lngLen)
    If lngX <> 0 Then
        fOSUserName = left$(strUserName, lngLen - 1)
    Else
        fOSUserName = ""
    End If
End Function

Environ("UserName")

    
Type Patient 

    dtmdrc As Date   'date création 

    strIPP As String 'numéro d'IPP 

    strNom As String 'Nom 

    strNjf As String 'Nom de jeune fille 

    strPre As String 'Prénom 

    dtmDdn As Date   'Date de naissance 

    strGro As String 'Groupe sanguin 

    strRhe As String 'Rhésus 

    strAdr As String 'Adresse 

    strCpo As String 'Code postal 

    strVil As String 'Ville 

    strTel As String 'Téléphone 

    lngCjt As Long   'numéro de conjoint attaché à la fiche adminstrative 

End Type 

Dim udtPatient As Patient  

    udtPatient.dtmdrc = #12/10/1968# 

    udtPatient.strIPP = "021584" 

    udtPatient.strNom = "LA GAFFE" 

    udtPatient.strNjf = "" 

    udtPatient.strPre = "Gaston"

DBEngine.Workspaces(0).Users(strUser).Groups("admins").Name

Dim esp As Workspace 
Dim strUser As String 

On Error Resume Next 
strUser = Application.CurrentUser 
Set esp = DBEngine.Workspaces(0) 
'L'instruction suivante provoque ou non une erreur 
strUser = esp.Users(strUser).Groups("admins").Name 
    
If Err.Number = 3265 Then    
    'élément non trouvé dans cette collection, l'utilisateur n'est pas administrateur 
ElseIf Err.Number > 0 Then  
   'autre erreur 
ElseIf Err.Number = 0 Then  
   'l'utilisateur appartient au groupe 'administrateur' 
End If

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Function fGetUserName() As String
  Dim strUserName As String
  strUserName = String(100, vbNullChar)
  GetUserName strUserName, 100
  strUserName = Left$(strUserName, InStr(strUserName, vbNullChar) - 1)
  fGetUserName = strUserName
End Function

With DBEngine.Workspaces(0)
 .Users(.UserName).NewPassword "ancienmotdepasse", "nouveaumotdepasse"
End With

Private Sub CmdAnnuler_Click()
    On Error GoTo err
    
    DoCmd.Close
    
err:
    Select Case err
        Case 0
        Case Else
            MsgBox err.Description & vbLf & err.Source
    End Select
    
End Sub
 
Private Sub CmdValider_Click()
    On Error GoTo err
 
    If Me.OldPwd = Me.NewPwd Then
        MsgBox "Le nouveau mot de passe est identique à l'ancien." & vbLf & _
            "Veuillez choisir un autre mot de passe.", vbOKOnly + vbExclamation, "Nouveau mot de passe invalide"
        Me.NewPwd = ""
        Me.ConfNewPwd = ""
        DoCmd.GoToControl Me.NewPwd
        Else
        If Me.NewPwd <> Me.ConfNewPwd Then
            MsgBox "Le mot de passe entré en confirmation" & vbLf & _
                "ne correspond pas au nouveau mot de passe.", vbOKOnly + vbExclamation, "Erreur de confirmation"
            Me.NewPwd = ""
            Me.ConfNewPwd = ""
            DoCmd.GoToControl Me.NewPwd
            Else
            With DBEngine.Workspaces(0)
                .Users(.UserName).NewPassword Me.OldPwd, Me.NewPwd
            End With
            MsgBox "Le mot de passe a été changé.", vbOKOnly + vbInformation, "Confirmation"
            DoCmd.Close
        End If
    End If
 
err:
    Select Case err
        Case 3033
            MsgBox "L'ancien mot de passe saisi n'est pas valide.", vbOKOnly + vbExclamation, "Ancien mot de passe incorrect"
            Me.OldPwd = ""
            Me.NewPwd = ""
            Me.ConfNewPwd = ""
            DoCmd.GoToControl ("OldPwd")
        Case 0
        Case Else
            MsgBox err.Description & vbLf & err.Source
    End Select
    
End Sub
 
Private Sub Form_Load()
    On Error GoTo err
    
    Me.UtilCourant = "Utilisateur courant : " & DBEngine.Workspaces(0).UserName
 
err:
    Select Case err
        Case 0
        Case Else
            MsgBox err.Description & vbLf & err.Source
    End Select
    
End Sub