
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