'EXPORTCONTACTS.VBS
'Version 1.0 
'Last Modified 6:54 AM 7/12/2002
'Pavel Nagaev 
'pavel.nagaev@cpcpipe.ru
'Summary: Export email addresses to CSV file for import them to Address Book in Outlook 2000
'Usage: cscript //nologo exportcontacts.vbs
 
'*********************************************************************************
'* THIS PROGRAM IS OFFERED AS IS AND MAY BE FREELY MODIFIED OR ALTERED AS *
'* NECESSARY TO MEET YOUR NEEDS. *
'* THE AUTHOR MAKES NO GUARANTEES OR WARRANTIES, EXPRESS, IMPLIED OR OF ANY *
'* OTHER KIND TO THIS CODE OR ANY USER MODIFICATIONS *
'* DO NOT USE IN A PRODUCTION ENVIRONMENT UNTIL YOU HAVE TESTED IN A SECURED LAB *
'* ENVIRONMENT. USE AT YOUR OWN RISK. *
'*********************************************************************************
 
'User parameters
'------------------------------------------------------------------------------------------------------
const FILENAME= "c:\contacts.csv"     'File name for exporting data from  Active Directory
const LDAPQUERY= "LDAP://hmspdc/DC=highmountschool,DC=com" 'LDAP query to Active Directory, where 
'DC_server is the DC server name                                                  'domainname – Your domain name
'23------------------------------------------------------------------------------------------------------
 
Dim con, com, rs, fso, f
 
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile(FILENAME, 2, True) ' ForReading = 1, ForWriting = 2, ForAppending = 8
 
'30Creating the CSV file header 
'for Outlook 2000, Outlook Express
 f.Write  "Last Name,First Name,E-mail address" & VbCrLf 
 
'for MS Exchange 5.5 f.Write  "Obj-class,Last Name,First Name,E-mail address" & VbCrLf 
 
'Connecting to Active Directory
    Set con = CreateObject("ADODB.Connection")
    Set com = CreateObject("ADODB.Command")
    con.Provider = "ADsDSOObject"
    con.Open "Active Directory Provider"
    Set com.ActiveConnection = con
   
'43This query select only not hidden users and contacts
com.CommandText = "select givenname,sn,objectCategory,objectClass,mail,msExchHideFromAddressLists" _
	& " from '" & LDAPQUERY & "' where objectClass= 'user' order by sn" _
	& " or objectClass= 'contact' order by sn"

 
    com.Properties("Page Size") = 1000
 
'Run query to Active Directory
 msgbox com.commandtext
    Set rs = com.Execute
       
    rs.MoveFirst
    While Not rs.EOF
     Tmail = rs.Fields("mail")
     Tsn   = rs.Fields("sn")
     TgivenName = rs.Fields("givenName")
 
     'Write the records to the CDV file which don’t have empty “First Name”, “Last Name”,
             ' “Email address”  fields. 
 
    If ((Tmail <> "" And Tsn <> "" And _
	TgivenName <> "") And IsNull(rs.Fields("msExchHideFromAddressLists"))) Then
 
       'for Outlook 2000 and Outlook 5.5
        f.Write  Tsn &","& TgivenName & "," & Tmail & VbCrLf
 
       'for Exchange 5.5   f.Write  "Remote," & Tsn &","& TgivenName & ",SMTP:" & Tmail & VbCrLf
 
    End If
        rs.MoveNext
   Wend
    
     rs.Close
     f.Close
 
wscript.quit