Bind to AD using Alternative Credentials VBS

Below is a VBS Script by MVP Richard L. Mueller which I found very useful. It shows you how to connect to Active Directory using alternative credentials.

Please view his original post here:
http://www.rlmueller.net/ADOAltCredentials.htm

Option Explicit

Dim objRootDSE, strDNSDomain, adoCommand, adoConnection
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
Dim strDN, strUser, strPassword, objNS, strServer

Const ADS_SECURE_AUTHENTICATION = &H1
Const ADS_SERVER_BIND = &H200

' Specify a server (Domain Controller).
strServer = "MyServer"

' Specify or prompt for credentials.
strUser = "MyDomain\TestUser"
strPassword = "xyz12345"

' Determine DNS domain name. Use server binding and alternate
' credentials. The value of strDNSDomain can also be hard coded.
Set objNS = GetObject("LDAP:")
Set objRootDSE = objNS.OpenDSObject("LDAP://" & strServer & "/RootDSE", _
strUser, strPassword, _
ADS_SERVER_BIND Or ADS_SECURE_AUTHENTICATION)
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory.
' Use alternate credentials.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Properties("User ID") = strUser
adoConnection.Properties("Password") = strPassword
adoConnection.Properties("Encrypt Password") = True
adoConnection.Properties("ADSI Flag") = ADS_SERVER_BIND _
Or ADS_SECURE_AUTHENTICATION
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection

' Search entire domain. Use server binding.
strBase = "
' Search for all users.
strFilter = "(&(objectCategory=person)(objectClass=user))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName"

' Construct the LDAP query.
strQuery = strBase & ";" & strFilter & ";" _
& strAttributes & ";subtree"

' Run the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values.
strDN = adoRecordset.Fields("distinguishedName").Value
Wscript.Echo strDN
adoRecordset.MoveNext
Loop

' Clean up.
adoRecordset.Close
adoConnection.Close