how to check service state using vbscript? - service

Is there anyway to check the status of service using vbscript ? I would like to have a function for each possible service state :
LINK
Any help would be great. I did write a function for checking if service is stopped :
Public Function IsServiceStop(ByVal serviceName)
On Error Resume Next
Dim objServices, service
Set oWmiService = GetObject("winmgmts:\\.\root\cimv2")
Set objServices = oWmiService.ExecQuery("Select * from Win32_Service where Name='" & serviceName & "'")
For Each service In objServices
IsServiceStop = (service.Started = False)
Exit Function
Next
IsServiceStop = True
On Error Goto 0
End Function

When in doubt, read the documentation. All you need to do is check the State property of the service object:
serviceName = "..."
Set wmi = GetObject("winmgmts://./root/cimv2")
state = wmi.Get("Win32_Service.Name='" & serviceName & "'").State
WScript.Echo state

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery ("Select * from Win32_Service Where Name ='" & strServiceName & "'")
For Each objService in colListOfServices
status = objService.State
Next
Reporter.ReportEvent micPass, "startService", "Service status " & status

' Michael Maher
' 3/10/07
' Checks if services exists and is running
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colRunningServices = objWMIService.ExecQuery("Select * from Win32_Service Where Name='Messenger'")
nItems = colRunningServices.Count
' If the collection count is greater than zero the service will exist.
If nItems > 0 Then
For Each objItem in colRunningServices
If objItem.State = "Stopped" Then
Wscript.Echo objItem.DisplayName & " Installed/Stopped"
ElseIf objItem.State = "Started" Then
Wscript.Echo objItem.DisplayName & " Installed/Running"
End If
Next
Else
Wscript.Echo "Service Not Installed"
End If
Here is the source

Related

VBscript to ping a list of computers

I'm using this VBscript code to ping a list of computers in a notepad and store the ping results in a csv file.
All computers stored in a notepad file are now availables (cmd >>> ping servername), but the results in csv file are all DOWN.
I have tried also stored in notepad file one computer unavailable, but the results ping in a csv file are all DOWN...
Any suggestion?
My code below
dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut
strInputPath = "C:\serverlist.txt"
strOutputPath = "C:\output.csv"
set objFSO = CreateObject("Scripting.FileSystemObject")
set objTextIn = objFSO.OpenTextFile( strInputPath,1 )
set objTextOut = objFSO.CreateTextFile( strOutputPath )
objTextOut.WriteLine("computer,status")
Do until objTextIn.AtEndOfStream = True
strComputer = objTextIn.ReadLine
if fPingTest( strComputer ) then
strStatus = "UP"
else
strStatus = "DOWN"
end if
objTextOut.WriteLine(strComputer & "," & strStatus)
loop
function fPingTest( strComputer )
dim objShell,objPing
dim strPingOut, flag
set objShell = CreateObject("Wscript.Shell")
set objPing = objShell.Exec("ping " & strComputer)
strPingOut = objPing.StdOut.ReadAll
if instr(LCase(strPingOut), "reply") then
flag = TRUE
else
flag = FALSE
end if
fPingTest = flag
end function
You can use this function IsOnLine :
dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut
strInputPath = "C:\serverlist.txt"
strOutputPath = "C:\output.csv"
set objFSO = CreateObject("Scripting.FileSystemObject")
set objTextIn = objFSO.OpenTextFile( strInputPath,1 )
set objTextOut = objFSO.CreateTextFile( strOutputPath )
objTextOut.WriteLine("computer,status")
Do until objTextIn.AtEndOfStream = True
strComputer = objTextIn.ReadLine
if IsOnLine(strComputer) then
strStatus = "UP"
else
strStatus = "DOWN"
end if
objTextOut.WriteLine(strComputer & "," & strStatus)
loop
'---------------------------------------------------------------------------------------
Function IsOnLine(strHost)
Dim objPing,objRetStatus
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
("select * from Win32_PingStatus where address = '" & strHost & "'")
For Each objRetStatus In objPing
If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
IsOnLine = False
Else
IsOnLine = True
End If
Next
End Function
'---------------------------------------------------------------------------------------

VBS Script that shows the files created on a specific date

I want to create a script that shows the files created on a specific date in a specific location.
As for now I created this:
Set objWMIService = GetObject("winmgmts:" & "!\\" & "." & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery ("Select * from CIM_DataFile where Drive='C:' AND Path='\\' AND CreationDate Like '20071107%' ")
For Each objFile in colFiles
Buffer = Buffer & objFile.FileName & " - " & objFile.CreationDate & vbNewLine
Next
Wscript.echo Buffer
But I am getting error in this line: " AND CreationDate Like '20071107%' "
So it does not work in such a way as I thought it will be - in C:\ I have a lot eula.txt files created on 2007 11 07.
I do not ask about finished code, but only for a clue. Thanks!
WHERE clause of a WQL query defends or inhibits from using wildcards in CIM_DATETIME values. Use SWbemDateTime object as follows:
option explicit
On Error GoTo 0
Dim strResult: strResult = Wscript.ScriptName
Dim objWMIService, colFiles, objFile, dTargetDate, dMinDate, dMaxDate, dateTime
Set dateTime = CreateObject("WbemScripting.SWbemDateTime")
dTargetDate = #2007-11-07# ' date literal in yyyy-mm-dd format
dateTime.SetVarDate( dTargetDate) ' convert to CIM_DATETIME
dMinDate = datetime
dateTime.SetVarDate( DateAdd( "d", 1, dTargetDate))
dMaxDate = datetime
strResult = strResult & vbNewLine & dMaxDate
Set objWMIService = GetObject("winmgmts:" & "!\\" & "." & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery ( _
"Select * from CIM_DataFile where Drive='c:' AND Path='\\'" _
& " AND CreationDate >= '" & dMinDate & "'" _
& " AND CreationDate < '" & dMaxDate & "'" _
)
If colFiles.Count = 0 Then
strResult = strResult & vbNewLine & "no files found"
Else
For Each objFile in colFiles
strResult = strResult & vbNewLine & objFile.FileName & " " & objFile.Extension _
& " - " & objFile.CreationDate
Next
End If
Wscript.Echo strResult
Wscript.Quit

How to test the internet connection behind a proxy?

I have this vbscript that works well on Windows 7 32-bit without proxy
In order to improve it, I seek for this solution: How to test internet connection behind a proxy ?
The solution perhaps it will be in VBScript or Powershell or Batch, much as I find a way to check whether i am connected or not behind a proxy !
The piece of code to improve it when i'm behind a proxy
If there is a trick to check if i'm connected to internet when i'm behind a proxy this is my question ?
If CheckConnection = true then
Msgbox "i'm connected to internet",vbinformation+vbSystemModal,"Check connection to internet"
Else
Msgbox "i'm not connected to internet",vbCritical+vbSystemModal,"Check connection to internet"
End if
'***************************************************************************
Function CheckConnection()
CheckConnection = False
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
MyLoop = False
CheckConnection = True
Exit Function
End If
Next
End Function
'******************************************************************************
The hole code :
Option Explicit
Dim Title,MyScriptPath,DJBuzzRadio,MyLoop,strComputer,objPing,objStatus,FSO,FolderScript,URLICON,Icon
Title = "Radio DJ Buzz Live by © Hackoo © 2015"
MyScriptPath = WScript.ScriptFullName
Set FSO = Createobject("Scripting.FileSystemObject")
FolderScript = FSO.GetParentFolderName(MyScriptPath) 'Chemin du dossier ou se localise le Vbscript
Icon = FolderScript & "\akg.ico"
URLICON = ChrW(104)&ChrW(116)&ChrW(116)&ChrW(112)&ChrW(58)&ChrW(47)&ChrW(47)&ChrW(104)&ChrW(97)&ChrW(99)&ChrW(107)&ChrW(111)&ChrW(111)&ChrW(46)&ChrW(97)&ChrW(108)&ChrW(119)&ChrW(97)&ChrW(121)&ChrW(115)&ChrW(100)&ChrW(97)&ChrW(116)&ChrW(97)&ChrW(46)&ChrW(110)&ChrW(101)&ChrW(116)&ChrW(47)&ChrW(97)&ChrW(107)&ChrW(103)&ChrW(46)&ChrW(105)&ChrW(99)&ChrW(111)
If Not FSO.FileExists(Icon) Then Call Download(URLICON,Icon)
DJBuzzRadio = ChrW(104)&ChrW(116)&ChrW(116)&ChrW(112)&ChrW(58)&ChrW(47)&ChrW(47)&ChrW(119)&ChrW(119)&ChrW(119)&ChrW(46)&ChrW(99)&ChrW(104)&ChrW(111)&ChrW(99)&ChrW(114)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(115)&ChrW(46)&ChrW(99)&ChrW(104)&ChrW(47)&ChrW(100)&ChrW(106)&ChrW(98)&ChrW(117)&ChrW(122)&ChrW(122)&ChrW(114)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(95)&ChrW(119)&ChrW(105)&ChrW(110)&ChrW(100)&ChrW(111)&ChrW(119)&ChrW(115)&ChrW(46)&ChrW(109)&ChrW(112)&ChrW(51)&ChrW(46)&ChrW(97)&ChrW(115)&ChrW(120)
Call Shortcut(MyScriptPath,"DJ Buzz Radio")
MyLoop = True
If CheckConnection = True Then Call AskQuestion()
'***************************************************************************
Function CheckConnection()
CheckConnection = False
While MyLoop = True
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
MyLoop = False
CheckConnection = True
Exit Function
End If
Next
Pause(10) 'To sleep for 10 secondes
Wend
End Function
'***************************************************************************
Sub Play(URL)
Dim Sound
Set Sound = CreateObject("WMPlayer.OCX")
Sound.URL = URL
Sound.settings.volume = 100
Sound.Controls.play
do while Sound.currentmedia.duration = 0
wscript.sleep 100
loop
wscript.sleep (int(Sound.currentmedia.duration)+1)*1000
End Sub
'***************************************************************************
Sub Shortcut(CheminApplication,Nom)
Dim objShell,fso,DesktopPath,objShortCut,MyTab,strCurDir
Set objShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
strCurDir = fso.GetParentFolderName(WScript.ScriptFullName)
MyTab = Split(CheminApplication,"\")
If Nom = "" Then
Nom = MyTab(UBound(MyTab))
End if
DesktopPath = objShell.SpecialFolders("Desktop")
Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Nom & ".lnk")
objShortCut.TargetPath = Dblquote(CheminApplication)
ObjShortCut.IconLocation = strCurDir & "\akg.ico"
objShortCut.Save
End Sub
'*****************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************************************
Function AppPrevInstance()
With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
" AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")
AppPrevInstance = (.Count > 1)
End With
End With
End Function
'******************************************************************************
Function CommandLineLike(ProcessPath)
ProcessPath = Replace(ProcessPath, "\", "\\")
CommandLineLike = "'%" & ProcessPath & "%'"
End Function
'******************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'******************************************************************************
Sub AskQuestion()
Dim Question,MsgAR,MsgFR,MsgEN
MsgFR = "Voulez-vous écouter DJ Buzz Radio en direct ?" & vbcr & "Oui = Pour écouter" & vbcr & "Non = Pour arrêter" & vbcr & String(50,"*")
MsgEN = "Did you want to listen to the Radio DJ Buzz Live ?" & vbcr & "Yes = To listen" & vbcr & "No = To stop" & vbcr & String(50,"*")
MsgAR = ChrW(1607)&ChrW(1604)&ChrW(32)&ChrW(1578)&ChrW(1585)&ChrW(1610)&ChrW(1583)&ChrW(32)&ChrW(1571)&ChrW(1606)&ChrW(32)&ChrW(1578)&ChrW(1587)&ChrW(1605)&ChrW(1593)&ChrW(32)&ChrW(32)&ChrW(1604)&ChrW(1575)&ChrW(1610)&ChrW(1601)&ChrW(32)&ChrW(1585)&ChrW(1575)&ChrW(1583)&ChrW(1610)&ChrW(1608)&ChrW(32)&ChrW(68)&ChrW(74)&ChrW(32)&ChrW(66)&ChrW(117)&ChrW(122)&ChrW(122)&ChrW(32)&ChrW(82)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(32)&ChrW(63) & vbcr & ChrW(1606)&ChrW(1593)&ChrW(1605)&ChrW(32)&ChrW(61)&ChrW(32)&ChrW(1604)&ChrW(1575)&ChrW(1587)&ChrW(1578)&ChrW(1605)&ChrW(1575)&ChrW(1593) & vbcr & ChrW(1604)&ChrW(1575)&ChrW(32)&ChrW(61)&ChrW(32)&ChrW(1604)&ChrW(1608)&ChrW(1602)&ChrW(1601) & vbcr &_
String(50,"*")
Question = MsgBox(MsgFR & vbcr & MsgEN & vbcr & MsgAR,vbYesNO+vbQuestion+vbSystemModal,Title)
If Question = VbYes And Not AppPrevInstance() Then
Call Play(DJBuzzRadio)
End If
If Question = VbYes And AppPrevInstance() Then
MsgBox "There is another instance in execution !" & VbCrLF &_
"Il y a une autre instance en cours d'exécution !"& VbcrLF &_
ChrW(1607)&ChrW(1606)&ChrW(1575)&ChrW(1603)&ChrW(32)&ChrW(1605)&ChrW(1579)&ChrW(1575)&ChrW(1604)&ChrW(32)&ChrW(1570)&ChrW(1582)&ChrW(1585)&ChrW(32)&ChrW(1601)&ChrW(1610)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1578)&ChrW(1606)&ChrW(1601)&ChrW(1610)&ChrW(1584)& VbcrLF &_
CommandLineLike(WScript.ScriptName),VbExclamation+vbSystemModal,Title
WScript.Quit()
End If
If Question = VbNo And Not AppPrevInstance() Then
Call Kill("wscript.exe")
End If
If Question = VbNo And AppPrevInstance() Then
Call Kill("wscript.exe")
End If
End Sub
'******************************************************************************
Sub Kill(MyProcess)
Dim Titre,colItems,objItem,Processus,Question
Titre = " Processus "& DblQuote(MyProcess) &" en cours d'exécution "
Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
& "Where Name like '%"& MyProcess &"%' AND commandline like " & CommandLineLike(WScript.ScriptFullName) & "",,48)
For Each objItem in colItems
objItem.Terminate(0)' Tuer ce processus
Next
End Sub
'******************************************************************************
Sub Download(strFileURL,strHDLocation)
Dim objXMLHTTP,objADOStream
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", strFileURL, false
objXMLHTTP.send()
If objXMLHTTP.Status = 200 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
objADOStream.SaveToFile strHDLocation,2
objADOStream.Close
Set objADOStream = Nothing
End If
Set objXMLHTTP = Nothing
Shortcut MyScriptPath,"DJ Buzz Radio"
MsgBox "Un raccourci a été crée sur votre bureau !"& vbcr &_
"A shortcut was created on your desktop !"& vbcr &_
ChrW(1578)&ChrW(1605)&ChrW(32)&ChrW(1573)&ChrW(1606)&ChrW(1588)&ChrW(1575)&ChrW(1569)&ChrW(32)&ChrW(1575)&ChrW(1582)&ChrW(1578)&ChrW(1589)&ChrW(1575)&ChrW(1585)&ChrW(32)&ChrW(1593)&ChrW(1604)&ChrW(1609)&ChrW(32)&ChrW(1587)&ChrW(1591)&ChrW(1581)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1605)&ChrW(1603)&ChrW(1578)&ChrW(1576),vbSystemModal+vbInformation,Title
End Sub
'**************************************************************************
If you mean the settings of the local computer you can query the registry:
REG QUERY "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings" /v ProxyEnable
If the value is 0x1 then the there is set proxy. You can check also the proxy value through the value of ProxyServer at the same location. More info here.
You can check if your external IP is the same like your internal IP address.
This uses winhttpjs.bat
for /f "skip=1 tokens=* delims=" %%a in ('winhhttpjs.bat "http://www.telize.com/ip" -saveTo con') do (
set "ip=%%a"
)
ipconfig| find "%ip%" || (
echo not real IP/proxy
)

time variable in vb script

I m trying to use a variable in the VB script at multiple places. This variable is is being calculated everytime i call the variable.
is there a way the script can use the initial value of the variable?
For Example -
In Sub StartServers, the DatenTime variable has a certain time value (eg: 2014-01-16-16-10-01.50) and after 120 Seconds sleep time, the DatenTime value in the Sub routine SendMail has 120 seconds added to the value (eg: 2014-01-16-16-12-01.50) causing a different time stamp, and attachment to is not sent as it cannot find the file name.
Thanks in advance for any answers. Please let me know if need more details.
=============================
DatenTime = "%date:~10,4%-%date:~4,2%-%date:~7,2%_%time:~0,2%_%time:~3,2%_%time:~6,5%"
Sub StartServers
wshShell.Run "E:\Automation\bin\queryhpe.cmd > E:\Automation\log\query_hpe_"&DatenTime&".log"
WScript.Sleep 120000
End Sub
Sub SendMail
On Error Resume Next
.
.
.
.
.
Set .Configuration = iConf
.To = sEmailList.ReadLine
.From = "<admin#example.com>"
.Subject = "STAGE: Querying Windows Services at " & Time & " on " & Date
.Textbody = "STAGE: Querying Windows executed at " & Time & " on " & Date & " by " & sWho & "." & vbcrlf & vbcrlf & "Pls find the info on following location " & "Pls Review attached logs for detailed information"
.AddAttachment "E:\Automation\log\query_hpe_"&DatenTime&".log"
.Send
End With
Loop
End Sub
Don't use environment variables for constructing a timestamp string in VBScript. Use the appropriate VBScript functions instead:
Function LPad(v) : LPad = Right("00" & v, 2) : End Function
t = Now
DatenTime = Year(t) & "-" & LPad(Month(t)) & "-" & LPad(Day(t)) _
& "_" & LPad(Hour(t)) & "_" & LPad(Minute(t)) & "_" & LPad(Second(t)) _
& "." & LPad(Left(Timer * 1000 Mod 1000, 2))
The expression Timer * 1000 Mod 1000 determines the number of milliseconds that have elapsed since the last full second.
You just need to create a variable above the Sub and store the Date/Time to it. Then refer to this variables in the Sub.
DatenTime = "%date:~10,4%-%date:~4,2%-%date:~7,2%_%time:~0,2%_%time:~3,2%_%time:~6,5%"
Dim StartDate, StartTime
StartDate = Date
StartTime = Time
Sub StartServers
wshShell.Run "E:\Automation\bin\queryhpe.cmd > E:\Automation\log\query_hpe_"&DatenTime&".log"
WScript.Sleep 120000
End Sub
Sub SendMail
On Error Resume Next
.
.
.
.
.
Set .Configuration = iConf
.To = sEmailList.ReadLine
.From = "<admin#example.com>"
.Subject = "STAGE: Querying Windows Services at " & StartTime & " on " & StartDate
.Textbody = "STAGE: Querying Windows executed at " & StartTime & " on " & StartDate & " by " & sWho & "." & vbcrlf & vbcrlf & "Pls find the info on following location " & "Pls Review attached logs for detailed information"
.AddAttachment "E:\Automation\log\query_hpe_"&DatenTime&".log"
.Send
End With
Loop
End Sub

Query all objects in active directory using LDAP, vbScript or PowerShell

I'm hoping someone has already developed a script to do this.
I'm need to query all objects in AD (users, computers, containers (OU's), everything exceot for the forest root) and show which objects in AD do not have the "Include inheritable permissions from this object's parent" attribute checked.
Thanks much
If you show some initiative, I can help in VBS. I wrote a VBS a while ago to query everything in AD for below attributes via LDAP, and putting results in Excel and plain text file.
"objectCategory"
"objectClass"
"objectGUID"
"objectSid"
"sIDHistory"
"sAMAccountName"
"description"
"sAMAccountType"
"userAccountControl"
"whenCreated"
"whenChanged"
"givenName"
"sn"
"displayName"
"title"
"mail"
"physicalDeliveryOfficeName"
"memberOf"
"telephoneNumber"
"mobile"
"pager"
"company"
"lastLogon"
"badPwdCount"
"badPasswordTime"
"streetAddress"
"l"
"postalCode"
"st"
"co"
I will show you my first 50/360 lines of code:
Const ADS_SCOPE_SUBTREE = 2
Const PageSize = 2000
Const GAP = "——————————————————————————————————————————————————"
'=== Public Variables ===
Dim aADProp, sRootLDAP, oRecordSet, oFSO, oLogFile, oExcel, oWB, oWS
Dim lObjects, lComputersEnabled, lUsersEnabled, lComputersDisabled, lUsersDisabled, lOtherDisabled, lExcelRow
Dim aUAC ' AD's UserAccountControl flags array
Dim aSAT ' AD's sAMAccountType flags array
'==================================================
Main
'==================================================
Sub Main
Init
ConnectAD
If Err.Number = 0 Then ProcessRecords
CleanUp
End Sub
'--------------------------------------------------
Sub Init
Dim dNow
dNow = Now
Wscript.echo dNow & vbTab & "Init"
DefineADProp
DefineUACArray
DefineSATArray
Set oFSO = CreateObject("scripting.filesystemobject")
Set oLogFile = oFSO.CreateTextFile(WScript.ScriptFullName & "_" & Join(Array(Year(dNow),Month(dNow),Day(dNow)),".") & ".log")
sRootLDAP = "'LDAP://" & GetObject("LDAP://RootDSE").Get("defaultNamingContext") & "'"
LogT vbCrlf & Q(WScript.ScriptFullName) & " started."
Logg "RootLDAP: " & sRootLDAP
Logg "Listing AD Attributes: " & Join(aADProp,", ")
Logg GAP
lObjects = 0
lUsersEnabled = 0
lUsersDisabled = 0
lComputersEnabled = 0
lComputersDisabled = 0
lOtherDisabled = 0
If Err.Number = 0 Then
lExcelRow = 1
Set oExcel = CreateObject("Excel.Application")
oExcel.visible = True
Set oWB = oExcel.Workbooks.Add
Set oWS = oWB.Worksheets(1)
oWS.Cells(lExcelRow,1) = "distinguishedName"
oWS.Range(oWS.Cells(lExcelRow,2),oWS.Cells(lExcelRow,UBound(aADProp)+2)) = aADProp
End If
End Sub
Yes I made a mistake and didn't post the question initially. When I posted originally, I wasn't able to enumerate all AD objects and had a question about that, but it is since been resolved and the code below works (in case anyone else needs it - sharing is OK). No need to try and reinvent the wheel if the code already existed. And many thanks to Rems # Petri
'
'//----------------------------- Code below -----------------------------//
'
Const SE_DACL_PROTECTED = &H1000
Dim objRootDSE
With WScript.CreateObject("WScript.Network")
Set objRootDSE = GetObject ("LDAP://" & .UserDomain & "/RootDSE")
End With
strDomainDN = objRootDSE.Get("DefaultNamingContext")
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
objCommand.Properties("Searchscope") = 2 ' SUBTREE
objCommand.Properties("Page Size") = 250
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & strDomainDN & "'"
Set objRecordSet = objCommand.Execute
On Error Resume Next
If Not objRecordSet.eof Then
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
ModUser objRecordSet.Fields("ADsPath").Value
objRecordSet.MoveNext
Loop
End If
objRecordset.Close : objConnection.Close
wscript.echo vbCrLf & "-- All done --" : wscript.quit 0
Sub ModUser(strADsPath)
Dim objUser, objNtSecurityDescriptor, intNtSecurityDescriptorControl
Set objuser = GetObject(strADsPath)
Set objNtSecurityDescriptor = objUser.Get("ntSecurityDescriptor")
intNtSecurityDescriptorControl = objNtSecurityDescriptor.Control
If (intNtSecurityDescriptorControl And SE_DACL_PROTECTED) Then
Wscript.Echo objUser.sAMAccountName & " (" & objUser.distinguishedName & ") is NOT checked"
End If
End Sub