Start Free Trial

asked on

This vbs script stops in the middle and shows no output also.

Hi,

This vbs script stops in the middle and shows no output also.
Can i have the log created and updating happening from the first system.
So if it gets stuck i know which machine its stuck at.

Can we skip those errors.

This script queries all machines and gets the shares details. if possible please record the everypne full access shares only and not all shares.

Regards
Sharath

Where's the script?

ASKER

Sorry missed that

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const strInputFile = "Computers.txt"
Const strOutputFile = "ServerShares.csv"

strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""

Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objInputFile.AtEndOfStream
	strServer = objInputFile.ReadLine
	If Ping(strServer) = True Then
		GetShareAccessInfo(strServer)
	Else
		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		
	End If
Wend
objInputFile.Close

MsgBox "Script has finished going through servers. Please see " & strOutputFile
Set objFile = objFSO.CreateTextFile(strOutputFile, True)
objFile.Write strResults
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing

Sub GetShareAccessInfo(strServer)
	WScript.Echo "Enumerating " & strServer
	On Error Resume Next
	Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")
	If Err.Number = 0 Then
		For Each objItem In colItems
			' Check for Disk shares only
			If objItem.Type = 0 Then
				'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
				On Error Resume Next
				Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
				RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
				If Err.Number <> 0 Then
					strTrustee = ""
					strType = ""
					strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description
					Err.Clear
					On Error GoTo 0
				Else
					On Error GoTo 0
					' Retrieve the DACL array of Win32_ACE objects.
					DACL = wmiSecurityDescriptor.DACL
					strAccessMask = ""
					For Each wmiAce In DACL
						'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf
						Set Trustee = wmiAce.Trustee
						If IsNull(Trustee.Domain) Then
							strTrustee = Trustee.Name
						Else
							strTrustee = Trustee.Domain & "\" & Trustee.Name
						End If
						'strAccessMask = strAccessMask & "Trustee: " & strTrustee
						Select Case wmiAce.AceType
							Case 0
								strType = "Allow"
							Case 1
								strType = "Deny"
						End Select
						'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType
						Select Case wmiAce.AccessMask
							Case 1179817
								strAccessMask = "Read (" & wmiAce.AccessMask & ")"
							Case 1245631
								strAccessMask = "Change (" & wmiAce.AccessMask & ")"
							Case 2032127
								strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"
							Case Else
								strAccessMask = "Custom (" & wmiAce.AccessMask & ")"
						End Select
						strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"
					Next
				End If		
		    End If
		Next
	Else
		Err.Clear
		On Error GoTo 0
		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
	End If
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

If you take out the 'On Error Resume Next' on line 44, you'll see it's line 45 that's failing with error 0x80041002. You'll not get the error reported via the variable strAccessMask, in line 50, is never displayed or written to file..

Not sure if that helps, but I think that's your root cause.

I believe line 45 is failing as the share has no permissions. When you check in Windows Explorer, it will probably show up as "Everyone" though. If you add a real user, the error may not occur. Just need to change the script to handle the situation?

ASKER

Yes need to skip if error occurs and the script only outputs finally after quering all machines.
If possible need to create the report from the first machine. So i know how its progressing as well

how about on error resume?

Which OS are you using? The script behaves differently on my home (Windows 7) and work PC (WInXP SP3)...

ASKER

I am running from a win Xp machine with Sp3

Sharath, try this.

It should have reporting at each branch, so you should see at least *something* in the report for each server.

Regards,

Rob.

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const strInputFile = "Computers.txt"
Const strOutputFile = "ServerShares.csv"

strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""

Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objInputFile.AtEndOfStream
	strServer = objInputFile.ReadLine
	If Ping(strServer) = True Then
		GetShareAccessInfo(strServer)
	Else
		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		
	End If
Wend
objInputFile.Close

MsgBox "Script has finished going through servers. Please see " & strOutputFile
Set objFile = objFSO.CreateTextFile(strOutputFile, True)
objFile.Write strResults
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing

Sub GetShareAccessInfo(strServer)
	WScript.Echo "Enumerating " & strServer
	On Error Resume Next
	Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")
	If Err.Number = 0 Then
		For Each objItem In colItems
			' Check for Disk shares only
			If objItem.Type = 0 Then
				'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
				On Error Resume Next
				Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
				RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
				If Err.Number <> 0 Then
					strTrustee = ""
					strType = ""
					strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description
					strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""
					Err.Clear
					On Error GoTo 0
				Else
					On Error GoTo 0
					' Retrieve the DACL array of Win32_ACE objects.
					DACL = wmiSecurityDescriptor.DACL
					strAccessMask = ""
					For Each wmiAce In DACL
						'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf
						Set Trustee = wmiAce.Trustee
						If IsNull(Trustee.Domain) Then
							strTrustee = Trustee.Name
						Else
							strTrustee = Trustee.Domain & "\" & Trustee.Name
						End If
						'strAccessMask = strAccessMask & "Trustee: " & strTrustee
						Select Case wmiAce.AceType
							Case 0
								strType = "Allow"
							Case 1
								strType = "Deny"
						End Select
						'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType
						Select Case wmiAce.AccessMask
							Case 1179817
								strAccessMask = "Read (" & wmiAce.AccessMask & ")"
							Case 1245631
								strAccessMask = "Change (" & wmiAce.AccessMask & ")"
							Case 2032127
								strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"
							Case Else
								strAccessMask = "Custom (" & wmiAce.AccessMask & ")"
						End Select
						strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"
					Next
				End If		
		    End If
		Next
	Else
		Err.Clear
		On Error GoTo 0
		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
	End If
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

ASKER

Thanks Rob at one machine it gets stuck and does not move to next machine.

ASKER

Rob i deleted the machine names where it gets stuck. But the csv file is not available it does not save

Shanmuga Sundaram D

bsharath the output file should be created in the directory where the script is running from. If you want the file to be created and read from the specific location then replace these lines

Const strInputFile = "Computers.txt"
Const strOutputFile = "ServerShares.csv"

with

Const strInputFile = "C:\Computers.txt"
Const strOutputFile = "c:\ServerShares.csv"

This will create the output file in c drive root. similarly this will read the file from the c drive root.

Try this.....it should output in a more verbose manner, hopefully giving us a clue as to where it stops. You should see more output in the DOS prompt as it goes through the servers in computers.txt

Regards,

Rob.

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const strInputFile = "Computers.txt"
Const strOutputFile = "ServerShares.csv"

strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""

WScript.Echo "Opening input file..."
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objInputFile.AtEndOfStream
	strServer = objInputFile.ReadLine
	WScript.Echo "Pinging " & strServer
	If Ping(strServer) = True Then
		WScript.Echo strServer & " responded. Getting share info..."
		GetShareAccessInfo(strServer)
	Else
		WScript.Echo strServer & " did not respond."
		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		
	End If
Wend
objInputFile.Close

WScript.Echo VbCrLf & "Creating output file " & strOutputFile
Set objFile = objFSO.CreateTextFile(strOutputFile, True)
objFile.Write strResults
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
WScript.Echo "Output file created."

MsgBox "Script has finished going through servers. Please see " & strOutputFile

Sub GetShareAccessInfo(strServer)
	WScript.Echo "Enumerating " & strServer
	On Error Resume Next
	WScript.Echo "Connecting to " & strServer & " via WMI..."
	Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")
	If Err.Number = 0 Then
		WScript.Echo "WMI connection successful"
		For Each objItem In colItems
			' Check for Disk shares only
			If objItem.Type = 0 Then
				WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."
				'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
				On Error Resume Next
				Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
				RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
				If Err.Number <> 0 Then
					WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description
					strTrustee = ""
					strType = ""
					strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description
					strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""
					Err.Clear
					On Error GoTo 0
				Else
					WScript.Echo "Enumerating DACL..."
					On Error GoTo 0
					' Retrieve the DACL array of Win32_ACE objects.
					DACL = wmiSecurityDescriptor.DACL
					strAccessMask = ""
					For Each wmiAce In DACL
						'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf
						Set Trustee = wmiAce.Trustee
						If IsNull(Trustee.Domain) Then
							strTrustee = Trustee.Name
						Else
							strTrustee = Trustee.Domain & "\" & Trustee.Name
						End If
						'strAccessMask = strAccessMask & "Trustee: " & strTrustee
						Select Case wmiAce.AceType
							Case 0
								strType = "Allow"
							Case 1
								strType = "Deny"
						End Select
						'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType
						Select Case wmiAce.AccessMask
							Case 1179817
								strAccessMask = "Read (" & wmiAce.AccessMask & ")"
							Case 1245631
								strAccessMask = "Change (" & wmiAce.AccessMask & ")"
							Case 2032127
								strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"
							Case Else
								strAccessMask = "Custom (" & wmiAce.AccessMask & ")"
						End Select
						WScript.Echo "Storing share access results for " & strTrustee & "..."
						strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"
					Next
				End If		
		    End If
		Next
	Else
		WScript.Echo "WMI Error connecting to " & strServer
		Err.Clear
		On Error GoTo 0
		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
	End If
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

ASKER

Rob the script runs now. But cannot find the csv where its stored...

If you get the message "Script has finished going through servers" then you should find ServerShares.csv in the same folder as the VBS file.

Rob.

ASKER

Running it again now...
Can you help with this please...
https://www.experts-exchange.com/questions/26501147/I-need-help-with-a-HTA-that-has-2-dropdowns.html

ASKER

Rob the script gets stuck at one machine

Retrieving Logical Share Security Settings for ProdvVerIssues...
Enumerating DACL...
Storing share access results for Everyone...
Pinging Dev051
Dev051 responded. Getting share info...
Enumerating De051
Connecting to Dev051 via WMI...

if i remove that machine and run again it gets stuck at another machine. can we record the faiure and skip or sort this issue.

It should *eventually* get past that. When you connect to a machine via WMI using GetObject, there's no time-out that you can set. You just have to wait for the GetObject call to return some error code, which my code traps and should output, and then continue. How long have you left it for? It shouldn't take more than 10 minutes maximum I don't think.

Regards,

Rob.

ASKER

But its been 12 hrs and its still stuck on this one machine

OK, maybe try this. It adds one more line of error checking.

Rob.

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const strInputFile = "Computers.txt"
Const strOutputFile = "ServerShares.csv"

strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""

WScript.Echo "Opening input file..."
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objInputFile.AtEndOfStream
	strServer = objInputFile.ReadLine
	WScript.Echo "Pinging " & strServer
	If Ping(strServer) = True Then
		WScript.Echo strServer & " responded. Getting share info..."
		GetShareAccessInfo(strServer)
	Else
		WScript.Echo strServer & " did not respond."
		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		
	End If
Wend
objInputFile.Close

WScript.Echo VbCrLf & "Creating output file " & strOutputFile
Set objFile = objFSO.CreateTextFile(strOutputFile, True)
objFile.Write strResults
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
WScript.Echo "Output file created."

MsgBox "Script has finished going through servers. Please see " & strOutputFile

Sub GetShareAccessInfo(strServer)
	WScript.Echo "Enumerating " & strServer
	On Error Resume Next
	WScript.Echo "Connecting to " & strServer & " via WMI..."
	Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
	If Err.Number = 0 Then
		WScript.Echo "WMI connection successful.  Enumerating Win32_Share information..."
		Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")
		If Err.Number = 0 Then
			For Each objItem In colItems
				' Check for Disk shares only
				If objItem.Type = 0 Then
					WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."
					'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
					On Error Resume Next
					Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
					RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
					If Err.Number <> 0 Then
						WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description
						strTrustee = ""
						strType = ""
						strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description
						strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""
						Err.Clear
						On Error GoTo 0
					Else
						WScript.Echo "Enumerating DACL..."
						On Error GoTo 0
						' Retrieve the DACL array of Win32_ACE objects.
						DACL = wmiSecurityDescriptor.DACL
						strAccessMask = ""
						For Each wmiAce In DACL
							'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf
							Set Trustee = wmiAce.Trustee
							If IsNull(Trustee.Domain) Then
								strTrustee = Trustee.Name
							Else
								strTrustee = Trustee.Domain & "\" & Trustee.Name
							End If
							'strAccessMask = strAccessMask & "Trustee: " & strTrustee
							Select Case wmiAce.AceType
								Case 0
									strType = "Allow"
								Case 1
									strType = "Deny"
							End Select
							'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType
							Select Case wmiAce.AccessMask
								Case 1179817
									strAccessMask = "Read (" & wmiAce.AccessMask & ")"
								Case 1245631
									strAccessMask = "Change (" & wmiAce.AccessMask & ")"
								Case 2032127
									strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"
								Case Else
									strAccessMask = "Custom (" & wmiAce.AccessMask & ")"
							End Select
							WScript.Echo "Storing share access results for " & strTrustee & "..."
							strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"
						Next
					End If		
			    End If
			Next
		Else
			WScript.Echo "Error enumerating Win32_Share information on " & strServer
			Err.Clear
			On Error GoTo 0
			strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
		End If
	Else
		WScript.Echo "WMI Error connecting to " & strServer
		Err.Clear
		On Error GoTo 0
		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
	End If
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

ASKER

Hi Rob i get this and its stuck

Pinging Dev00
Dev00 responded. Getting share info...
Enumerating Dev00
Connecting to Dev00 via WMI...

Hmmmm, the GetObject call should be eventually timing out.....

What happens if you replace this line:
      Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")

with this:
      Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
      Set objWMI = objSWbemLocator.ConnectServer(strServer, "root\cimv2")

Rob.

ASKER

Checking
Rob if time permits a small change is neede please help
https://www.experts-exchange.com/questions/26517566/Script-that-creates-an-email-Need-help-in-removing-a-particular-word-that-comes-in.html?cid=239&anchorAnswerId=33819720#a33819720

and this
https://www.experts-exchange.com/questions/26516702/Excel-macro-to-create-emails-from-the-data-in-a-sheet.html

ASKER

Rob still gets stuck here

Pinging Dev0
Dev0 responded. Getting share info...
Enumerating Dev0
Connecting to Dev0 via WMI...

OK, what happens if you open a command prompt and run this:
wmic /NODE:"Dev0" computersystem get name

Does it sit there forever and not return anything? If there's a WMI problem, it should cause an error.

Rob.

ASKER

Rob even that command just stays intact without any change.
Even the script gets stuck with that machine and hrs later also there is no change

ASKER

I get this

C:\>wmic /NODE:"Dev0" computersystem ge
t name
Node - Dev0
ERROR:
Code = 0x800706ba
Description = The RPC server is unavailable.
Facility = Win32

OK, that error from WMIC is what I expected to happen. How long did it take to do that?

Anyway, I've made the code use WMIC for the WMI connection test, so hopefully it will at least *eventually* time out.

Rob.

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const strInputFile = "Computers.txt"
Const strOutputFile = "ServerShares.csv"

strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""

WScript.Echo "Opening input file..."
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objInputFile.AtEndOfStream
	strServer = objInputFile.ReadLine
	WScript.Echo "Pinging " & strServer
	If Ping(strServer) = True Then
		WScript.Echo strServer & " responded. Getting share info..."
		GetShareAccessInfo(strServer)
	Else
		WScript.Echo strServer & " did not respond."
		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		
	End If
Wend
objInputFile.Close

WScript.Echo VbCrLf & "Creating output file " & strOutputFile
Set objFile = objFSO.CreateTextFile(strOutputFile, True)
objFile.Write strResults
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
WScript.Echo "Output file created."

MsgBox "Script has finished going through servers. Please see " & strOutputFile

Sub GetShareAccessInfo(strServer)
	WScript.Echo "Enumerating " & strServer
	On Error Resume Next
	WScript.Echo "Connecting to " & strServer & " via WMI..."
	intReturn = objShell.Run("wmic /NODE:""" & strServer & """ computersystem get name", 0, True)
	If intReturn = 0 Then
		Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
		If Err.Number = 0 Then
			WScript.Echo "WMI connection successful.  Enumerating Win32_Share information..."
			Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")
			If Err.Number = 0 Then
				For Each objItem In colItems
					' Check for Disk shares only
					If objItem.Type = 0 Then
						WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."
						'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
						On Error Resume Next
						Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
						RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
						If Err.Number <> 0 Then
							WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description
							strTrustee = ""
							strType = ""
							strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description
							strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""
							Err.Clear
							On Error GoTo 0
						Else
							WScript.Echo "Enumerating DACL..."
							On Error GoTo 0
							' Retrieve the DACL array of Win32_ACE objects.
							DACL = wmiSecurityDescriptor.DACL
							strAccessMask = ""
							For Each wmiAce In DACL
								'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf
								Set Trustee = wmiAce.Trustee
								If IsNull(Trustee.Domain) Then
									strTrustee = Trustee.Name
								Else
									strTrustee = Trustee.Domain & "\" & Trustee.Name
								End If
								'strAccessMask = strAccessMask & "Trustee: " & strTrustee
								Select Case wmiAce.AceType
									Case 0
										strType = "Allow"
									Case 1
										strType = "Deny"
								End Select
								'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType
								Select Case wmiAce.AccessMask
									Case 1179817
										strAccessMask = "Read (" & wmiAce.AccessMask & ")"
									Case 1245631
										strAccessMask = "Change (" & wmiAce.AccessMask & ")"
									Case 2032127
										strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"
									Case Else
										strAccessMask = "Custom (" & wmiAce.AccessMask & ")"
								End Select
								WScript.Echo "Storing share access results for " & strTrustee & "..."
								strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"
							Next
						End If		
				    End If
				Next
			Else
				WScript.Echo "Error enumerating Win32_Share information on " & strServer
				Err.Clear
				On Error GoTo 0
				strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
			End If
		Else
			WScript.Echo "WMI Error connecting to " & strServer
			Err.Clear
			On Error GoTo 0
			strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
		End If
	Else
		WScript.Echo "WMI Error (via WMIC) connecting to " & strServer
		Err.Clear
		On Error GoTo 0
		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""		
	End If
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

ASKER

Rob i get this

---------------------------
Windows Script Host
---------------------------
Script:      D:\Shares.vbs
Line:      4
Char:      5
Error:      Object required: 'objShell'
Code:      800A01A8
Source:       Microsoft VBScript runtime error

---------------------------
OK
---------------------------

Whoops.

Set objShell = CreateObject("Wscript.Shell")
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
Const strInputFile = "Computers.txt"
Const strOutputFile = "ServerShares.csv"

strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""

WScript.Echo "Opening input file..."
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objInputFile.AtEndOfStream
	strServer = objInputFile.ReadLine
	WScript.Echo "Pinging " & strServer
	If Ping(strServer) = True Then
		WScript.Echo strServer & " responded. Getting share info..."
		GetShareAccessInfo(strServer)
	Else
		WScript.Echo strServer & " did not respond."
		strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		
	End If
Wend
objInputFile.Close

WScript.Echo VbCrLf & "Creating output file " & strOutputFile
Set objFile = objFSO.CreateTextFile(strOutputFile, True)
objFile.Write strResults
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
WScript.Echo "Output file created."

MsgBox "Script has finished going through servers. Please see " & strOutputFile

Sub GetShareAccessInfo(strServer)
	WScript.Echo "Enumerating " & strServer
	On Error Resume Next
	WScript.Echo "Connecting to " & strServer & " via WMI..."
	intReturn = objShell.Run("wmic /NODE:""" & strServer & """ computersystem get name", 0, True)
	If intReturn = 0 Then
		Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
		If Err.Number = 0 Then
			WScript.Echo "WMI connection successful.  Enumerating Win32_Share information..."
			Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")
			If Err.Number = 0 Then
				For Each objItem In colItems
					' Check for Disk shares only
					If objItem.Type = 0 Then
						WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."
						'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
						On Error Resume Next
						Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
						RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
						If Err.Number <> 0 Then
							WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description
							strTrustee = ""
							strType = ""
							strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description
							strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""
							Err.Clear
							On Error GoTo 0
						Else
							WScript.Echo "Enumerating DACL..."
							On Error GoTo 0
							' Retrieve the DACL array of Win32_ACE objects.
							DACL = wmiSecurityDescriptor.DACL
							strAccessMask = ""
							For Each wmiAce In DACL
								'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf
								Set Trustee = wmiAce.Trustee
								If IsNull(Trustee.Domain) Then
									strTrustee = Trustee.Name
								Else
									strTrustee = Trustee.Domain & "\" & Trustee.Name
								End If
								'strAccessMask = strAccessMask & "Trustee: " & strTrustee
								Select Case wmiAce.AceType
									Case 0
										strType = "Allow"
									Case 1
										strType = "Deny"
								End Select
								'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType
								Select Case wmiAce.AccessMask
									Case 1179817
										strAccessMask = "Read (" & wmiAce.AccessMask & ")"
									Case 1245631
										strAccessMask = "Change (" & wmiAce.AccessMask & ")"
									Case 2032127
										strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"
									Case Else
										strAccessMask = "Custom (" & wmiAce.AccessMask & ")"
								End Select
								WScript.Echo "Storing share access results for " & strTrustee & "..."
								strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"
							Next
						End If		
				    End If
				Next
			Else
				WScript.Echo "Error enumerating Win32_Share information on " & strServer
				Err.Clear
				On Error GoTo 0
				strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
			End If
		Else
			WScript.Echo "WMI Error connecting to " & strServer
			Err.Clear
			On Error GoTo 0
			strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
		End If
	Else
		WScript.Echo "WMI Error (via WMIC) connecting to " & strServer
		Err.Clear
		On Error GoTo 0
		strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""		
	End If
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

ASKER

Hi Rob this time it was running without any issue. But suddenly the script completed and no csv file saved
ServerShares.csv

OK, try this. It will output to the file as it goes through each server, and also *make sure* that the output file is created in the same folder as the VBS.

Just out of interest....could you check your C:\Windows\System32\ folder the ServerShares.csv file?

Rob.

Set objShell = CreateObject("Wscript.Shell")
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

Set objFSO = CreateObject("Scripting.FileSystemObject")
Const intForReading = 1
strInputFile = "Computers.txt"
strOutputFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "ServerShares.csv"

WScript.Echo VbCrLf & "Creating output file " & strOutputFile
Set objFile = objFSO.CreateTextFile(strOutputFile, True)

'strResults = """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""
objOutputFile.WriteLine """SERVER"",""SHARE NAME"",""SHARED PATH"",""TRUSTEE"",""ACCESS TYPE"",""ACCESS MASK"""
WScript.Echo "Opening input file..."
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
While Not objInputFile.AtEndOfStream
	strServer = objInputFile.ReadLine
	WScript.Echo "Pinging " & strServer
	If Ping(strServer) = True Then
		WScript.Echo strServer & " responded. Getting share info..."
		GetShareAccessInfo(strServer)
	Else
		WScript.Echo strServer & " did not respond."
		'strResults = strResults & VbCrLf & """" & strServer & """,""OFFLINE"""		
		objOutputFile.WriteLine """" & strServer & """,""OFFLINE"""
	End If
Wend
objInputFile.Close

'objFile.Write strResults
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
WScript.Echo "Output file created."

MsgBox "Script has finished going through servers. Please see " & strOutputFile

Sub GetShareAccessInfo(strServer)
	WScript.Echo "Enumerating " & strServer
	On Error Resume Next
	WScript.Echo "Connecting to " & strServer & " via WMI..."
	intReturn = objShell.Run("wmic /NODE:""" & strServer & """ computersystem get name", 0, True)
	If intReturn = 0 Then
		Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
		If Err.Number = 0 Then
			WScript.Echo "WMI connection successful.  Enumerating Win32_Share information..."
			Set colItems = objWMIService.ExecQuery("Select Type,Name,Path From Win32_Share")
			If Err.Number = 0 Then
				For Each objItem In colItems
					' Check for Disk shares only
					If objItem.Type = 0 Then
						WScript.Echo "Retrieving Logical Share Security Settings for " & objItem.Name & "..."
						'Set wmiFileSecSetting = GetObject("winmgmts:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
						On Error Resume Next
						Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2:Win32_LogicalShareSecuritySetting.Name='" & objItem.Name & "'")
						RetVal = wmiFileSecSetting.GetSecurityDescriptor(wmiSecurityDescriptor)
						If Err.Number <> 0 Then
							WScript.Echo "Error enumerating Share Settings. Error " & Err.Number & ": " & Err.Description
							strTrustee = ""
							strType = ""
							strAccessMask = "GetSecurityDescriptor failed" & VbLf & Err.Number & VbLf & Err.Description
							'strResults = strResults & VbCrLf & """" & strServer & """,""GetSecurityDescriptor ERROR"""
							objOutputFile.WriteLine """" & strServer & """,""GetSecurityDescriptor ERROR"""
							Err.Clear
							On Error GoTo 0
						Else
							WScript.Echo "Enumerating DACL..."
							On Error GoTo 0
							' Retrieve the DACL array of Win32_ACE objects.
							DACL = wmiSecurityDescriptor.DACL
							strAccessMask = ""
							For Each wmiAce In DACL
								'If strAccessMask <> "" Then strAccessMask = strAccessMask & vbLf
								Set Trustee = wmiAce.Trustee
								If IsNull(Trustee.Domain) Then
									strTrustee = Trustee.Name
								Else
									strTrustee = Trustee.Domain & "\" & Trustee.Name
								End If
								'strAccessMask = strAccessMask & "Trustee: " & strTrustee
								Select Case wmiAce.AceType
									Case 0
										strType = "Allow"
									Case 1
										strType = "Deny"
								End Select
								'strAccessMask = strAccessMask & vbLf & "ACE Type: " & strType
								Select Case wmiAce.AccessMask
									Case 1179817
										strAccessMask = "Read (" & wmiAce.AccessMask & ")"
									Case 1245631
										strAccessMask = "Change (" & wmiAce.AccessMask & ")"
									Case 2032127
										strAccessMask = "Full Control (" & wmiAce.AccessMask & ")"
									Case Else
										strAccessMask = "Custom (" & wmiAce.AccessMask & ")"
								End Select
								WScript.Echo "Storing share access results for " & strTrustee & "..."
								'strResults = strResults & VbCrLf & """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"
								objOutputFile.WriteLine """" & strServer & """,""" & objItem.Name & """,""" & objItem.Path & """,""" & strTrustee & """,""" & strType & """,""" & strAccessMask & """"
							Next
						End If		
				    End If
				Next
			Else
				WScript.Echo "Error enumerating Win32_Share information on " & strServer
				Err.Clear
				On Error GoTo 0
				'strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
				objOutputFile.WriteLine """" & strServer & """,""WMI ERROR"""
			End If
		Else
			WScript.Echo "WMI Error connecting to " & strServer
			Err.Clear
			On Error GoTo 0
			'strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""
			objOutputFile.WriteLine """" & strServer & """,""WMI ERROR"""
		End If
	Else
		WScript.Echo "WMI Error (via WMIC) connecting to " & strServer
		Err.Clear
		On Error GoTo 0
		'strResults = strResults & VbCrLf & """" & strServer & """,""WMI ERROR"""		
		objOutputFile.WriteLine """" & strServer & """,""WMI ERROR"""		
	End If
End Sub

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

ASKER

I could not find the file in system32

I get this

D:\Shares.vbs(18, 1) Microsoft VBScript runtime error: Object required: 'objOutputFile'

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

Thanks Rob now the file is created..
Can you help with this
https://www.experts-exchange.com/questions/26516702/Excel-macro-to-create-emails-from-the-data-in-a-sheet.html