'**********************************************************************************
' *
' * 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