Hi ,Purpose of this code is to read data from Active directory and if cotact number is found blank for a user mail is sent .
This works fine when running this manually with my id or Scheduler Signer ID too but on scheduling it is getting stuck .
By default AD has read access to all those users listed in AD.
Is it like access is authenticating windowsid of the user who is running the code and not depending on agent signer id due to which this is running fine .
I presume there is some server to server access related issue OR Windows id is taking access to read data from AD or may be both.
Any suggestions will be appreciated.
Sub Initialize
Dim s As New NotesSession
Dim db As NotesDatabase
Dim EM As String
Dim Emobile As String
Dim objConnection As Variant
Dim objCommand As Variant
Dim objRecordSet As Variant
Const ADS_SCOPE_SUBTREE = 2
Set db = s.CurrentDatabase
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT * FROM 'LDAP://in.nam.ad.XYZ.com' WHERE userAccountControl= '512' OR userAccountControl= '544' " ' Modify this line with your actual LDAP server name
Set objRecordSet = objCommand.Execute
count=objRecordSet.RecordCount
If ( objRecordSet.RecordCount <> 0 ) Then
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
Print "Entering loop"
Set objUser = GetObject(objRecordSet.Fields("ADsPath").Value)
Print "Objuser set"
EM=objUser.mail
Emobile = objUser.homePhone 'Emergency phone number
Estaffname = objUser.firstname 'First Name required
If EM<>"" And Emobile="" Then
'Mail send code goes here'''''''''''''''''''''''''''''''''''''''''''''
Dim richStyle As NotesRichTextStyle
Set richStyle = s.CreateRichTextStyle
Set memo = New NotesDocument( db )
Dim rtitem As New NotesRichTextItem(memo, "Body")
memo.Form="Memo"
memo.Subject ="TEST"
Call rtitem.AppendText("TEST MAIL")
memo.SendTo = EM
Call memo.Send(True)
End If
objRecordSet.MoveNext
Loop
objRecordSet.close
End If
Exit Sub
End Sub