locked
Trying to obtain Windows Login data from Active Directory RRS feed

  • Question

  • Nowhere can I find the attribute to give me the login text that a Windows user uses to log in with from the Active Directory. I actually need a listing of all the users in the Directory. To be clear I don't want the name such as "Bloggs, Fred" but what Fred Bloggs has typed in to log into Wndows, say as example "Bloggs123" (followed by his password of course). I want to retrieve all of such log ins from the Directory. But I have searched and searched and found nothing which provides me with this exactly - plenty of other attributes, but not this one. Can someone point me in the right direction, or tell me which attribute from AD I need please? (I am doing this in Access VBA and SQL Server.)

    • Edited by Sansevieria Wednesday, February 10, 2016 12:33 AM
    • Moved by David_JunFeng Thursday, February 11, 2016 9:09 AM
    Wednesday, February 10, 2016 12:30 AM

All replies

  • here is code provided by Andrey ARTEMYEV

     I have used successfully to automatically call in Active Directory ID:

    Dim ADSI As Object

    Dim UN As Object
    Dim ADtest As Variant
         
         Set ADSI = CreateObject("ADSystemInfo")
         Set UN = GetObject("LDAP://" & ADSI.UserName)
         ADtest = UN.FirstName
         ADtest = ADtest & " " & UN.LastName
         Me.User = ADtest
         Set UN = Nothing
         Set ADSI = Nothing


    Wednesday, February 10, 2016 3:02 PM
  • Thanks Andrey, but I need the Windows user Login text - i.e. what the user uses to log into Windows, not his name. Any ideas on which ADSI Attribute that is?
    Wednesday, February 10, 2016 4:40 PM
  • This is a VBScript I use to get a list of members in an AD group. Maybe you can gleen what you need from it. The result is the username, department and email address.

    '\\\\\\
    '\\
    '\\ Filter AD groups, select a AD group and make a list of its users
    '\\ Frans Erich 16-02-06
    '\\
    '\\         Sub : CheckForUser and GetUserAccount taken from "ADuser" script from Ralph E Montgomery
    '\\         Function : SelectBox taken from script from T. Lavedas
    '\\
    '\\ Script only works in a domain environment
    '\\
    '\\\\\\\
    
    
    Dim objGroup, objUser, WshShell, strMessage, strDomain, strUserMail, strRootDSE, strGetUserName, Ouser, fso
    Dim objNet, major, minor, ver, strMail, strLogonName, strValue, strDisplayDescription, strDisplayDepartment, strDN
    Dim strSearch, strMostRecentIP, aOpt(), intOpt, oGroup, sGroup, txtFile, objComputer
    Dim objRootDSE, strTemp, strADsConfPath, strFormat, strFile, i, objConnection, objCommand, objRecordSet, objectRecordSet
    Dim strKey, strKeyValue, rval, strBCC, oMailApp, olMailItm, olMailItem, intSize, strDelegateCount
    
    Set WshShell = WScript.CreateObject("WScript.Shell")
    Set objNet = CreateObject("WScript.Network")
    Set objRootDSE = GetObject("LDAP://rootDSE")
    strADsConfPath = "LDAP://" & objRootDSE.Get("configurationNamingContext")
    strRootDSE = objRootDSE.Get("defaultNamingContext")
    strDomain = UCase(objNet.UserDomain)
    strSearch = LCase(InputBox("Give an optional value up on which you want filter groups."))
    ListGroups (strDomain)
    intOpt = 1
    sGroup = SelectBox("Select a group", aOpt)
    ' Change the value of variable "strFormat" to Outlook to generate a new mail containing all email addresses of the mebers in the BCC box.
    strFormat = "Excel"
    
    If sGroup <> "Select a group" Then
        Set oGroup = GetObject("WinNT://" & strDomain & "/" & sGroup & ",group")
    
            If strFormat = "Excel" Then
                'strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
                strTemp = "C:\Temp_C"
                strFile = strTemp & "\Member List " & sGroup & ".csv"
                Set fso = CreateObject("Scripting.FileSystemObject")
                If fso.FileExists(strFile) Then
                    fso.DeleteFile (strFile)
                End If
                Set txtFile = fso.CreateTextFile(strFile)
                i = 0
                For Each Ouser In oGroup.Members
                    i = i + 1
                    strGetUserName = ""
                    strDN = ""
                    strMail = ""
                    strGetUserName = UCase(Ouser.Name)
                    While strDN = ""
                        CheckForUser()
                    Wend
                    GetUserAccount (strDN)
                    txtFile.Write (Ouser.Name & ";" & strDisplayDepartment & ";" & strMail & vbCrLf)
                Next
                txtFile.Close
                Set txtFile = Nothing
                Set fso = Nothing
                strKey = "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\Excel.exe\path"
                'If KeyExists(strKey) = True Then
                '    strKeyValue = WshShell.regRead(strKey)
                '    rval = WshShell.Run(Chr(34) & strKeyValue & "excel.exe" & Chr(34) & " " & Chr(34) & strFile & Chr(34), 1, True)
                'Else
                '   rval = WshShell.Run("notepad.exe" & " " & strFile, 1, True)
                    rval = WshShell.Run(Chr(34) & "C:\Program Files\CSVed\CSVed.exe" & Chr(34) _
                        & " " & Chr(34) & strFile & Chr(34), 1, True)
                'End If
            Else
                For Each Ouser In oGroup.Members
                    i = i + 1
                    strGetUserName = ""
                    strDN = ""
                    strMail = ""
                    strGetUserName = UCase(Ouser.Name)
                    While strDN = ""
                        Call CheckForUser
                    Wend
                    GetUserAccount (strDN)
                    strBCC = strBCC & strMail & "; "
                Next
                Set oMailApp = CreateObject("Outlook.Application")
                Set olMailItm = oMailApp.CreateItem(olMailItem)
                olMailItm.BCC = strBCC
                olMailItm.Display
            End If
    End If
    
    Sub CheckForUser()
        Set objConnection = CreateObject("ADODB.Connection")
        objConnection.Provider = ("ADsDSOObject")
        objConnection.Open
        Set objCommand = CreateObject("ADODB.Command")
        objCommand.ActiveConnection = objConnection
        objCommand.CommandText = _
        "<LDAP://" & strRootDSE & ">;(&(objectCategory=User)" & _
                                 "(samAccountName=" & strGetUserName & "));distinguishedName,sAMAccountName,name;subtree"
        Set objRecordSet = objCommand.Execute
        strDN = objRecordSet.Fields("distinguishedName")
        Set objectRecordSet = Nothing
        objConnection.Close
        Set objConnection = Nothing
    
    End Sub
    
    Sub GetUserAccount(strDN)
        On Error Resume Next
        If InStr(1, strDN, "/") Then strDN = Replace(strDN, "/", "\/")
        Set objUser = GetObject("LDAP://" & strDN & "")
        Set objAdS = GetObject("LDAP://" & strRootDSE & "")
    
        With objUser
            '.GetInfo
            strMail = .Get("mail")
            strLogonName = .Get("sAMAccountName")
            strUserMail = .Get("mail")
            strDescription = .GetEx("description")
            strDepartment = .GetEx("department")
    
            strDisplayDepartment = ""
            For Each strValue In strDepartment
                strDisplayDepartment = strDisplayDepartment & strValue
            Next
    
            For Each strValue In strDescription
                strDisplayDescription = strDisplayDescription & strValue
            Next
    
        End With
    
    End Sub
    
    Sub ListGroups(strDomain)
        Set objComputer = GetObject("WinNT://" & strDomain)
        objComputer.Filter = Array("Group")
        For Each objGroup In objComputer
            If InStr(LCase(objGroup.Name), strSearch) Then
                ReDim Preserve aOpt(intOpt + 1)
                aOpt(intOpt) = objGroup.Name
                intOpt = intOpt + 1
            End If
        Next
    End Sub
    
    Function SelectBox(sTitle, aOptions)
        Dim oIE, s, item
        Set oIE = CreateObject("InternetExplorer.Application")
        With oIE
            'Commented out for IE7
            '.FullScreen = True
            .Toolbar = False 
            .RegisterAsDropTarget = False
            .StatusBar = False 
            .Menubar = False
            .Addressbar = False
            .Navigate ("about:blank")
            Do Until .ReadyState = 4: WScript.Sleep 100: Loop
            .Width = 400: .Height = 200
            With .Document
                With .ParentWindow.Screen
                    oIE.Left = (.availWidth - oIE.Width) \ 2
                    oIE.Top = (.availheight - oIE.Height) \ 2
                End With
                s = "<html><head><title>" & sTitle _
                  & "</title></head><script language=vbs>bWait=true<" & "/script>" _
                  & "<body bgColor=Silver><center>" _
                  & "<b>" & sTitle & "<b><p>" _
                  & "<select id=entries size=1 style='width:325px'>" _
                  & " <option selected>" & sTitle & "</option>"
                For Each item In aOptions
                    s = s & " <option>" & item & "</option>"
                Next
                s = s & " </select><p>" _
                  & "<button id=but0 onclick='bWait=false'>OK</button>" _
                  & "</center></body></html>"
                .Open
                .Write (s)
                .Close
                Do Until .ReadyState = "complete": WScript.Sleep 50: Loop
                With .body
                    .Scroll = "no"
                    'Commented out for IE7
                    '.Style.BorderStyle = "outset"
                    .Style.BorderWidth = "3px"
                End With
                .all.entries.focus
                oIE.Visible = True
                CreateObject("Wscript.Shell").AppActivate sTitle
                'On Error Resume Next
                Do While .ParentWindow.bWait
                    WScript.Sleep 100
                    If oIE.Visible Then SelectBox = "Aborted"
                    If Err.Number <> 0 Then 
    		    set oIE =Nothing
    		    Exit Function
    		End If
                Loop
                'On Error GoTo 0
                With .ParentWindow.entries
                    SelectBox = .options(.selectedIndex).Text
                End With
            End With
            .Visible = False
        End With
        
        set oIE =Nothing
    
    End Function
    
    
    Function KeyExists(sKeyPath)
        KeyExists = False: If (sKeyPath = "") Then Exit Function
        'On Error Resume Next
        CreateObject("wscript.shell").regRead sKeyPath
        Select Case Err
            Case 0: KeyExists = True
            Case &H80070002: Dim sErrMsg
                sErrMsg = Replace(Err.Description, sKeyPath, "")
                Err.Clear
                CreateObject("wscript.shell").regRead "HKEY_ERROR\"
                KeyExists = Not (sErrMsg = Replace(Err.Description, "HKEY_ERROR\", ""))
            Case Else: KeyExists = False
        End Select
        'On Error GoTo 0
    End Function
    


    Bill Mosca
    www.thatlldoit.com
    http://tech.groups.yahoo.com/group/MS_Access_Professionals

    Wednesday, February 10, 2016 5:39 PM
  • Hi Sansevieria,

    First, please refer to others reply.

    Secondly, this issue is more related to VBA, the VBA forum is the better place for this issue and we will move it there for you.

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Thursday, February 11, 2016 9:07 AM