Udtræk brugere fra en domæne controller til en Access database

Jeg rodede med noget lignende en gang, men fandt aldrig de vise sten.

I stedet lavede jeg et VBScript som fylder data i en tabel
Du kan se feltnavnene nedenfor og tabellen hedder ADUsers.mdb - måske skal du rette i scriptet så det har den fulde sti med til databasen.
Du skal selvfølgelig også rette dc=DOMAINNAME til det rigtige domæne


On Error Resume Next
Dim objcommand
Dim objconnection
Dim strquery
Dim strdbpath
Dim objrecordset
Dim objaccessconnection
Dim objaccessrecordset
Dim objitem
Const ADS_UF_ACCOUNTDISABLE = 2
Const adLockOptimistic         = 3

' - Connect to AD
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strQuery = "<LDAP://dc=DOMAINNAME,dc=local>;(objectCategory=person);" & "adsPath;subtree"
objCommand.CommandText = strQuery
Set objRecordSet = objCommand.Execute

' - Open Access DB
Set objAccessConnection = CreateObject("ADODB.Connection")
Set objAccessRecordset = CreateObject("ADODB.Recordset")
strDBPath = "ADUsers.mdb"
objAccessConnection.open ("DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & strDBPath)
Set objAccessRecordset.ActiveConnection = objAccessConnection
objAccessRecordset.LockType = adLockOptimistic

' - delete all of the rows from the DB and populate it anew.
objAccessRecordset.source = "DELETE * FROM ADUsers"
objAccessRecordset.Open

' - now open one that we can use
objAccessRecordset.source = "Select * FROM ADUsers"
objAccessRecordset.Open

' - Loop through all of the users and insert their details into the DB
Do Until objRecordSet.EOF
    Set objItem     = GetObject(objRecordSet.Fields ("adspath"))
    objAccessRecordset.AddNew
    objAccessRecordset.Fields("DisplayName")    = objItem.displayName
    objAccessRecordset.Fields("UserID")            = objItem.sAMAccountName
    objAccessRecordset.Fields("EmailAddress")    = objItem.mail
   
    If objitem.userAccountControl And ADS_UF_ACCOUNTDISABLE Then
        objAccessRecordset.Fields("UserDisabled") = True
    Else
        objAccessRecordset.Fields("UserDisabled") = False
    End If
   
    objAccessRecordset.Update
    objRecordSet.MoveNext
Loop

Hej Hugo Pedersen

Hvis jeg kan få det til at virke, så kan jeg sagtens bruge dette.

Jeg har rettet DOMAINNAME, jeg har rettet ADUsers.mdb til navnet på min database, og jeg har lavet en tabel i databasen der hedder: ADUsers, der indeholder følgende felter: "Displayname", "UsersID", EmailAddress", "UsersDisabled".

MEN den står bare og kører i en uendelighed - er der noget jeg har glemt?

Hvis felterne er tilstrækkeligt store og UsersDisabled er et Ja/Nej felt så burde det fungere.
Det eneste jeg kan huske fra da jeg brugte det er at brugeren der eksekverer skal være administrator på domænet.
Desværre har jeg ikke nogen domænecontroller tilgængelig så jeg kan ikke teste det.

Jeg har redigeret scriptet lidt (Se lidt længere nede)

Og jeg kan også få det til at køre og smide en masse poster ind i en tabel, MEN den bliver bare ved at køre og køre og alle felter er blanke - da den nåede til post nummer 53.000 så stoppede jeg den - der er ca. 250 brugere, så et eller andet må være galt, og hvorfor er alle felter blanke?

Public Function ADUsers()

On Error Resume Next
Dim objcommand
Dim objconnection
Dim strquery
Dim objrecordset
Dim objitem

' - Connect to AD
Set objcommand = CreateObject("ADODB.Command")
Set objconnection = CreateObject("ADODB.Connection")
objconnection.Provider = "ADsDSOObject"
objconnection.Open "Active Directory Provider"
objcommand.ActiveConnection = objconnection
strquery = "<LDAP://dc=DOMAINNAME,dc=local>;(objectCategory=person);" & "adsPath;subtree"
objcommand.CommandText = strquery
Set objrecordset = objcommand.Execute

' - Insert into Table

Do Until objrecordset.EOF
Set objitem = GetObject(objrecordset.Fields("adspath"))

X1 = objitem.displayName
X2 = objitem.sAMAccountName
X3 = objitem.mail

DoCmd.SetWarnings False

strSQL = "INSERT INTO ADUsers ( DisplayName, UserID, Emailaddress ) SELECT " & X1 & " AS DName, " & X2 & " AS UID, " & X3 & " AS email;"
DoCmd.RunSQL strSQL

DoCmd.SetWarnings True

objrecordset.MoveNext
Loop

End Function

For det første mener jeg absolut du har en fejl i din SQL sætning. Men om det er det der får den til at gå i selvsving er jeg ikke sikker på.

strSQL = "INSERT INTO ADUsers ( DisplayName, UserID, Emailaddress ) & _
" SELECT '" & X1 & "', X2, '" & X3 & "'"

Hvad siger objrecordset.RecordCount? det giver et fingerpeg om hvor mange records du kan forvente.

PS: personligt bryder jeg mig ikke om Do Until objrecordset.EOF, jeg bruger altid
While Not objrecordset.EOF
  objrecordset.MoveNext
Wend
Men det er selvfølgilig en smagssag :-)

At jeg bruger:

" & X1 & " AS DName

altså "AS Dname" er gammel vane, så jeg kan holde styr på de enkelte variabler, når der indgår mange, og det har ikke nogen betydning.

Jeg har prøvet Objrecordset.recordCount, og den giver kun et blankt resultat, så jeg tror ikke at der er forbindelse til domaincontrolleren - eller den henter i hvert fald ikke det den skal. Det der undrer mig er at løkken kører i uendelig tid, hvis ikke den henter poster, men det er måske omvendt også derfor - altså, hvis outputtet er blankt, så kører den i en uendelighed.

Jeg har selvfølgelig ændret det til While/Wend ;-)

Så lykkedes det endeligt - Det er vigtigt at bruge store og små bogstaver i de navne der kaldes (der gik virkelig lang tid før jeg fandt ud af det)