set objIdDictionary = CreateObject("Scripting.Dictionary")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colServices = objWMIService.ExecQuery _
("Select * from Win32_Service Where State <> 'Stopped'")
For Each objService in colServices
If objIdDictionary.Exists(objService.ProcessID) Then
Else
objIdDictionary.Add objService.ProcessID, objService.ProcessID
End If
Next
colProcessIDs = objIdDictionary.Items
For i = 0 to objIdDictionary.Count - 1
Set colServices = objWMIService.ExecQuery _
("Select * from Win32_Service Where ProcessID = '" & _
colProcessIDs(i) & "'")

For Each objService in colServices
msg = msg & vbcrlf & " " & Ucase(objService.DisplayName) & ":" & " " & objService.Name & vbcrlf & objService.PathName & vbcrlf

Next
Next
Dim fso, Services,Wshshell
Set Wshshell = Wscript.CreateObject("Wscript.Shell")
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set Services = fso.CreateTextFile("Active.txt",true)
Services.Write "These are the Current Active Services:"
Services.WriteLine
Services.Write msg
Services.Close
Wshshell.Run "Active.txt"