VBA: Sign In Using Windows Authentication

I have an Access application that requires the user to enter their Windows domain user and password for input. For this, I used the following VBA code:

Function WindowsLogin(ByVal strUserName As String, ByVal strpassword As String, ByVal strDomain As String) As Boolean
    'Authenticates user and password entered with Active Directory. 

    On Error GoTo IncorrectPassword

    Dim oADsObject, oADsNamespace As Object
    Dim strADsPath As String

    strADsPath = "WinNT://" & strDomain
    Set oADsObject = GetObject(strADsPath)
    Set oADsNamespace = GetObject("WinNT:")
    Set oADsObject = oADsNamespace.OpenDSObject(strADsPath, strDomain & "\" & strUserName, strpassword, 0)

    WindowsLogin = True    'ACCESS GRANTED

ExitSub:
    Exit Function

IncorrectPassword:
    WindowsLogin = False   'ACCESS DENIED
    Resume ExitSub
End Function

I noticed that sometimes, when the information is entered correctly, access is denied. I tried to debug once and it gave an error: "Network path not found." in line Set oADsObject = oADsNamespace.OpenDSObject).

I don’t know why this happens sometimes. Is it better to convert to LDAP? I tried but cannot create the LDAP URL correctly.

+5
source share
2 answers

If the user has already authenticated through their Windows login, why would they enter the data again?

, , :

Declare Function IGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal sBuffer As String, lSize As Long) As Long

Function GetUserName() As String

    On Error Resume Next

    Dim sBuffer As String
    Dim lSize As Long
    Dim x As Long

    sBuffer = Space$(32)
    lSize = Len(sBuffer)
    x = IGetUserName(sBuffer, lSize)
    GetUserName = left$(sBuffer, lSize - 1)

End Function

+3

GxP . , Windows, .

0

All Articles