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