Excel – LDAP authentication

The beauty of Excel is the ubiquitousness of the program or support for the file formats. When adding business logic and power to these tools however it can be necessary to restrict access due to company confidential information.

Trying to accomplish this in Excel using VBA is basicly a curse due to the horrible developer environment, lack of debugging, and a fractured reference resource.

While with any programming process there are many ways to accomplish the goal and this is just one.

Assuming a userform that prompts for username and password it will add the domain name if necessary.



Const ADS_USE_SSL = 2


Dim conn As New ADODB.Connection

Dim rs As ADODB.RecordSet

Dim oRoot As Object

Dim oDomain As Object

Dim sBase As String

Dim sFilter As String

Dim sDomain As String


Dim sAttribs As String

Dim sDepth As String

Dim sQuery As String

Dim usern As String



On Error GoTo ErrHandler:


Set oRoot = GetObject(“LDAP://rootDSE”)


‘work in the default domain

sDomain = oRoot.Get(“defaultNamingContext”)



Set oDomain = GetObject(“LDAP://” & sDomain)


sBase = “<” & oDomain.ADsPath & “>”

‘Only get user name requested

sFilter = “(objectClass=*)”

sAttribs = “AdsPath, cn”

sDepth = “subTree”


sQuery = sBase & “;” & sFilter & “;” & sAttribs & “;” & sDepth

‘Add the domain to the user name

If InStr(1, txtUser.Text, “domainname”) = 0 Then

usern = “domainname” & txtUser.Text


usern = txtUser.Text

End If


Set conn = CreateObject(“ADODB.Connection”)

conn.Provider = “ADsDSOObject”

conn.Properties(“User Id”) = usern

conn.Properties(“Password”) = txtPass.Text

conn.Properties(“Encrypt Password”) = True

‘Set Flags to ensure secure authentication is used instead of simple



conn.Open “Active Directory Provider”


Set rs = conn.Execute(sQuery)

GoTo ExitSub




On Error Resume Next

If Not rs Is Nothing Then

If rs.State <> 0 Then rs.Close

Set rs = Nothing


End If


If Not conn Is Nothing Then

If conn.State <> 0 Then conn.Close

Set conn = Nothing


End If


Set oRoot = Nothing

Set oDomain = Nothing

MsgBox “You are not authorized to use this application, please contact an Administrator.”




Unload Me


End Sub