[ActiveDir] Active Directory Query Permission

[Michael B. Smith]

Title: Message

I have an LDAP query (see below and thanks Joe).

 

Runs fine when _I_ run it under my account. When I put it into an SMTP event sink (Ex2K sp3) - I get zero results. I presume it's a permissions issue. How do I fix this intelligently?

 

(Typical value for strDomain is "@exchange.brnets.com", typical value for varDomainNC is "DC=test,DC=brnets,DC=local")

 

Thanks.

 

Sub BuildAddressList (ByVal strDomain)
 Dim Conn ' As New ADODB.Connection
 Dim Com  ' As New ADODB.Command
 Dim Rs  ' As ADODB.Recordset
 Dim strQuery ' As String
 Dim Address ' As String
 Dim AddressList ' As Collection (Variant)

 

 set Conn = Wscript.CreateObject ("ADODB.Connection")
 set Com  = Wscript.CreateObject ("ADODB.Command")

 

 ' Open the connection.
 Conn.Provider = "ADsDSOObject"
 Conn.Open "ADs Provider"

 

 strQuery = "<LDAP://" & varDomainNC & ">;(&(proxyAddresses=*" & strDomain & ")(|((objectcategory=person)(objectcategory=group)(objectcategory=contact)(objectcategory=publicfolder))));userprincipalname,samaccountname,mail,proxyAddresses"

 

 Com.ActiveConnection = Conn
 Com.CommandText = strQuery
 Com.Properties("Page Size") = 1000

 

 Set Rs = Com.Execute

 

 ' Iterate through the results.
 While Not Rs.EOF
  'Wscript.echo _
  ' " userprincipalname " & rs.fields ("userprincipalname") & _
  ' " samaccountname " & rs.fields ("samaccountname") & _
  ' " mail " & rs.Fields ("mail")
  AddressList = rs.fields ("proxyAddresses")
  If Not IsNull (AddressList) Then
   For Each Address in Addresslist
    If Lcase (Left (Address, 5)) = "smtp:" Then
     If InStr (Address, strDomain) > 0 Then
      AddAddressEntry (Address)
     Else
      Discards = Discards + 1
     End If
    Else
     NonSMTPAddresses = NonSMTPAddresses + 1
    End If
   Next
  End If
  Rs.MoveNext
  TotalRecords = TotalRecords + 1
 Wend

 

 ' Done with querying LDAP
 Rs.Close 
 Conn.Close
 set Rs = Nothing
 set Com = Nothing
 set Conn = Nothing
End Sub