VBA: Login using Windows Authentication

问题:

I have a an Access App that requires the user to enter their Windows domain user and password to enter. I have used the following VBA code to accomplish this:

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 notice that sometimes when the information is entered correctly, access is denied. I tried to debug once and it gave the error: "The network path was not found. " on the Set oADsObject = oADsNamespace.OpenDSObject) line.

Not sure why this occurs sometimes. Is it better to convert to LDAP instead? I have tried but can't construct the LDAP URL correctly.

回答1:

If the user is already authenticated via their Windows login, why make them enter the details again?

If you need to know which user is logged in, you can get the username very easily by the following function:

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

回答2:

In GxP environment it is additionally needed to enter at least password. It doesn't matter if You are logged to Windows, You need to confirm it again.