I want the code below to loop through the array I created so that I
can create an html file for each department. I've tried a few methods,
but all result in error 800a03ea (trying to call a function within a
function?) As it is below, it works... but only on the first array
item. Any help on how I can loop through the remaining array items?
If you are feeling really generous, I would also like to automatically
populate the array from active directory with DISTINCT departments for
all users. This is secondary to what I need above though, but is of
interest.
Thanks for any assistance,
' Create an HTML table from Active Directory Info.
Dim sDepartments
sDepartments = Array("department1","department2","department3","department4")
Dim i
i = 0
Dim oRoot, sDomain
Set oRoot = GetObject("LDAP://rootDSE")
sDomain = oRoot.Get("defaultNamingContext")
SQLStmt = "SELECT displayName, department, telephoneNumber, mail " &
_
"FROM 'LDAP://" & sDomain & " ' " & _
"WHERE objectClass='User' AND objectCategory='Person' " & _
"ORDER BY displayName"
Set Conn = CreateObject("ADODB.Connection")
Conn.Provider = "ADSDSOObject"
Conn.Open "ADs Provider"
Set rs = Conn.Execute(SQLStmt)
Do While Not rs.EOF Or rs.BOF
If IsNull(rs.Fields("telephoneNumber").value) Then
rs.MoveNext
Else
If rs.Fields("department").Value = sDepartments(i) then
rows = rows & "<tr>"
rows = rows & "<td>" & count & "</td>"
'rows = rows & "<td>" & rs.Fields("department").Value &
" </td>"
rows = rows & "<td>" & rs.Fields("displayName").Value &
" </td>"
rows = rows & "<td>" & "<a href=mailto:" & rs.Fields("mail").Value
& ">" & rs.Fields("mail").Value & "</a> " & " </td>"
rows = rows & "<td>" & rs.Fields("telephoneNumber").Value &
" </td>"
rows = rows & "</tr>" & VBCrLf
rs.MoveNext
Else
rs.MoveNext
End if
End if
Loop
CreateFile rows
rs.close
set rs = nothing
conn.close
set conn = nothing
Sub CreateFile(rows)
dim html
html = "<html><head><title>Active Directory (" & sDomain &
")</title>"
html = html & "<body link='#0000CC' vlink='#0000CC' alink='#0000CC'>"
html = html & "<style type='text/css'><!--"
html = html & "th { font-family: Verdana; font-size: 8pt }"
html = html & "td { font-family: Verdana; font-size: 8pt }"
html = html & "--></style>"
html = html & "<body>"
html = html & "<table border=1>"
html = html & "<tr><th></th><th>Name</th><th>E-Mail
Address</th><th>Phone</th></tr>"
html = html & rows
html = html & "</table>"
html = html & "</body></html>"
Dim fso, tf
Set fso = CreateObject("Scripting.FileSystemObject")
Set tf = fso.CreateTextFile("C:\Documents and
Settings\admin\Desktop\" & sDepartments(i) & ".htm", True)
tf.Write(html)
tf.Close
set tf = nothing
set fso = nothing
End Sub