Extract all computer objects from Active Directory and send via email
Spread the love
'**********************************************************************************
' *
' * Title:              Export computer objects from AD and email results
' *
' * File Name:          ExportComputerstoEmail.vbs
' * Programmer(s):      Stephen Wireman
' *
' * First Written:      07/03/2019
' * Last Modified: 	
' *
' * Version:            1.0.0
' *
' * Purpose:            To extract computer object
' *                     information from Active Directory
' *                     and send it via email.
' *
' * Information:        Requires read permissions in Active Directory
' *                     for all queried objects
' *
' * Notes:              Will create the file Computers.txt in the same directory 
' *                     that this script is running from.
' *                     Replace xxxxx@mydomain.com with a routable email address
' *						Replace mail.mydomain.com with a valid SMTP address
' **********************************************************************************

' ***********************************************************
' * Define script constants                                 *
' ***********************************************************
Const ADS_SCOPE_SUBTREE 	= 2
Const ForWriting            = 2
Const ForAppending 			= 8 

Dim fso 			: 	Set fso = CreateObject("Scripting.FileSystemObject")
Dim cn 				:	Set cn = CreateObject("ADODB.Connection") 
Dim ObjoutputFile 	: 	Set ObjOutputFile = fso.OpenTextFile(".\Computers.txt", ForWriting, True) 

' ***********************************************************
' * Execution phase                                         *
' ***********************************************************

Call Main()
Call SendReport()
Call Finish()

' ***********************************************************
' * Functions and Sub Routines                              *
' ***********************************************************

 
Sub Main()
	Dim cmd
	Dim ou
	Dim rs 
	
	cn.Provider = "ADsDSOObject" 
	cn.Open "Active Directory Provider" 
	 
	Set cmd = CreateObject("ADODB.Command") 
	Set cmd.ActiveConnection = cn 
	 
	OU = "CN=Computers,DC=Mydomain,DC=Com" 
	cmd.CommandText = "SELECT name " & _ 
		 "FROM 'LDAP://" & ou & "' " & _ 
		 "WHERE objectClass='computer' " & _ 
		 "ORDER BY name" 
	cmd.Properties("Page Size") = 1000 
	cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 	
	Set rs = cmd.Execute 

	If Not rs.BOF Then 
		rs.MoveFirst
	End If

	Do Until rs.EOF 
		ObjOutputFile.WriteLine rs(0) 
		rs.MoveNext 
	Loop 

	ObjoutputFile.Close 
End Sub

Sub SendReport()

	Set objOutputFile = FSO.GetFile(".\Computers.txt")
	
	If objOutputFile.Size > 0 Then

		Set ObjOutputFile = fso.OpenTextFile(".\Computers.txt", 1, True)

		Set objEmail = CreateObject("CDO.Message")
		objEmail.From = "xxxxx@mydomain.com"
		objEmail.To = "xxxxxx@mydomain.com"
		objEmail.Subject = "Computers CN !!!" '
		objEmail.Textbody = "xxxxxxxxx." & vbCrLf & vbLf & ObjOutputFile.ReadAll
		objEmail.Configuration.Fields.Item _ 
		("https://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		objEmail.Configuration.Fields.Item _
		("https://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.mydomain.com"
		objEmail.Configuration.Fields.Item _
		("https://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
		objEmail.Configuration.Fields.Update
		objEmail.Send
		ObjoutputFile.Close
	Else
		Wscript.Echo "The file is empty."
	End If
End Sub

Sub Finish()
	Set ObjoutputFile 	= Nothing 
	Set fso 			= Nothing
	Set cn				= Nothing
End Sub

Leave a Comment

Your email address will not be published. Required fields are marked *