bsharath
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
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
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.
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
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.
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
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
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.
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.
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
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.
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
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.
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.
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.
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
ASKER
Hi Rob i get this and its stuck
Pinging Dev00
Dev00 responded. Getting share info...
Enumerating Dev00
Connecting to Dev00 via WMI...
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("WbemScriptin g.SWbemLoc ator")
Set objWMI = objSWbemLocator.ConnectSer ver(strSer ver, "root\cimv2")
Rob.
What happens if you replace this line:
Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
with this:
Set objSWbemLocator = CreateObject("WbemScriptin
Set objWMI = objSWbemLocator.ConnectSer
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
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...
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.
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
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
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.
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
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
-------------------------- -
--------------------------
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
ASKER
Hi Rob this time it was running without any issue. But suddenly the script completed and no csv file saved
ServerShares.csv
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.
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
ASKER
I could not find the file in system32
I get this
D:\Shares.vbs(18, 1) Microsoft VBScript runtime error: Object required: 'objOutputFile'
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.
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
Can you help with this
https://www.experts-exchange.com/questions/26516702/Excel-macro-to-create-emails-from-the-data-in-a-sheet.html