Solved

VB Script stopped working in Windows 7

Posted on 2014-03-14
10
1,435 Views
Last Modified: 2014-03-14
All,

My VB script works fine with Windows XP but once we migrated to Win 7 it stopped working. It gets to the point where it should prompt me to select a txt file. But the dialog box never pops up. Any assistance would be appreciated.

On Error Resume Next
Const ForReading = 1
Set objExcel = CreateObject("Excel.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
MsgBox "Select a text file to get machine names from",,"Select Text File"
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "Text Documents|*.txt|All Files|*.*"
objDialog.FilterIndex = 1
intResult = objDialog.ShowOpen
If intResult = 0 Then
    Wscript.Quit
Else
    Set objTextFile = objFSO.OpenTextFile (objDialog.FileName, ForReading)
End If
x=2
 
objExcel.Workbooks.Add
objExcel.Visible = True
                objExcel.Cells(1, 1).value = "ComputerFromList"
                objExcel.Cells(1, 2).value = "ComputerFromWMI"            
                objExcel.Cells(1, 3).value = "Online"
                objExcel.Cells(1, 4).value = "Connected"
                objExcel.Cells(1, 5).value = "PingResolveName"
                objExcel.Cells(1, 6).value = "PingResolveIP"        
                objExcel.Cells(1, 7).value = "IPAddress"
 
Do Until objTextFile.AtEndOfStream
                strName = ""
                strComputer = ""
                strComputer = objTextFile.Readline
                objExcel.Cells(x, 1).value = strComputer
y=7
 
                Set objShell = CreateObject("WScript.Shell")
                Set objExecObject = objShell.Exec ("%comspec% /c ping -n 1 -w 300 -a " & strcomputer)
                    strText = objExecObject.StdOut.ReadAll()
                    arrPingList = Split(strText , " ")
                    strText2 = arrPingList(1)
                    strText3 = arrPingList(2)
                If Instr(strText, "Reply") > 0 Then
        objExcel.Cells(x, 3).Value = "online"
 
       
        'Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
        Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
                If Err = 0 Then
                objExcel.Cells(x, 4).Value = "connected"
 
'Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colItems = objWMIService.ExecQuery("Select Name from Win32_ComputerSystem",,48)
                For Each objItem in colItems
                strName = objItem.Name
                Next
 
Set IPConfigSet = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
                For Each IPConfig in IPConfigSet
                                If Not IsNull(IPConfig.IPAddress) Then
                For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)          
                                objExcel.Cells(x, y).value = IPConfig.IPAddress(i)
                y=y+1    
                                Next
                                End If
                Next
               
                objExcel.Cells(x, 2).value = strName      
                Else
                objExcel.Cells(x, 4).Value = "cannot connect"
                objExcel.Cells(x, 5).value = strText2
                objExcel.Cells(x, 6).value = strText3
                End If
               
                Else objExcel.Cells(x, 3).Value = "offline"
                objExcel.Cells(x, 4).Value = "cannot connect"
                objExcel.Cells(x, 5).value = strText2
                objExcel.Cells(x, 6).value = strText3
                End If    
               
Err.Clear
x=x+1
 
Loop
objExcel.Close
0
Comment
Question by:Edward Pamias
  • 6
  • 4
10 Comments
 
LVL 67

Expert Comment

by:sirbounty
ID: 39929021
Try changing this line:
Set objDialog = CreateObject("UserAccounts.CommonDialog")
into this one:
Set objDialog = CreateObject("MSComDlg.CommonDialog")
0
 
LVL 14

Author Comment

by:Edward Pamias
ID: 39929051
Did not work...I got the same thing. I get the pop up to select txt file but an explorer window is suppose to appear for me to select the file.
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 39929103
64-bit?  I've read that the MSComDlg.CommonDialog component isn't supported on 64-bit os.

You could try something like this: http://wsh2.uw.hu/ch12f.html
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 39929106
This also appears to have a few replacements that work under Win7:
http://todayguesswhat.blogspot.com/2012/08/windows-7-replacement-for.html

Set shell = CreateObject( "WScript.Shell" )
defaultLocalDir = shell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop"
Set shell = Nothing

file = ChooseFile(defaultLocalDir)
MsgBox file

Function ChooseFile (ByVal initialDir)
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

    Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    Dim winVersion

    ' This collection should contain just the one item
    For Each objItem in colItems
        'Caption e.g. Microsoft Windows 7 Professional
        'Name e.g. Microsoft Windows 7 Professional |C:\windows|...
        'OSType e.g. 18 / OSArchitecture e.g 64-bit
        'Version e.g 6.1.7601 / BuildNumber e.g 7601
        winVersion = CInt(Left(objItem.version, 1))
    Next
    Set objWMIService = Nothing
    Set colItems = Nothing

    If (winVersion <= 5) Then
        ' Then we are running XP and can use the original mechanism
        Set cd = CreateObject("UserAccounts.CommonDialog")
        cd.InitialDir = initialDir
        cd.Filter = "ZIP files|*.zip|Text Documents|*.txt|Shell Scripts|*.*sh|All Files|*.*"
        ' filter index 4 would show all files by default
        ' filter index 1 would show zip files by default
        cd.FilterIndex = 1
        If cd.ShowOpen = True Then
            ChooseFile = cd.FileName
        Else
            ChooseFile = ""
        End If
        Set cd = Nothing    

    Else
        ' We are running Windows 7 or later
        Set shell = CreateObject( "WScript.Shell" )
        Set ex = shell.Exec( "mshta.exe ""about: <input type=file id=X><script>X.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(X.value);close();resizeTo(0,0);</script>""" )
        ChooseFile = Replace( ex.StdOut.ReadAll, vbCRLF, "" )

        Set ex = Nothing
        Set shell = Nothing
    End If
End Function    

Open in new window

0
 
LVL 14

Author Comment

by:Edward Pamias
ID: 39929120
Yes I have Win 7 64 bit.  The code above does not do what my script does, or at least I don't think so.
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 67

Accepted Solution

by:
sirbounty earned 500 total points
ID: 39929188
It should...it actually should allow for older version (pre-Win7) to work as well as Win7.

Try this with the code inserted into yours:  
(I commented out the "On Error" statement at the beginning - it can mask errors that can prove helpful.  If it pops up the dialog box as expected, you can remove the apostrophe from that line to re-enforce

'On Error Resume Next
Const ForReading = 1
Set objExcel = CreateObject("Excel.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
MsgBox "Select a text file to get machine names from",,"Select Text File"


'Set objDialog = CreateObject("UserAccounts.CommonDialog")
'objDialog.Filter = "Text Documents|*.txt|All Files|*.*"
'objDialog.FilterIndex = 1
'intResult = objDialog.ShowOpen
'If intResult = 0 Then
'    Wscript.Quit
'Else
'    Set objTextFile = objFSO.OpenTextFile (objDialog.FileName, ForReading)
'End If

defaultLocalDir = "C:\"
fileName = ChooseFile(defaultLocalDir)

If filename = "" then wscript.quit
Set objTextFile = objFSO.OpenTextFile (fileName, ForReading)
x=2
 
objExcel.Workbooks.Add
objExcel.Visible = True
                objExcel.Cells(1, 1).value = "ComputerFromList"
                objExcel.Cells(1, 2).value = "ComputerFromWMI"            
                objExcel.Cells(1, 3).value = "Online"
                objExcel.Cells(1, 4).value = "Connected"
                objExcel.Cells(1, 5).value = "PingResolveName"
                objExcel.Cells(1, 6).value = "PingResolveIP"        
                objExcel.Cells(1, 7).value = "IPAddress"
 
Do Until objTextFile.AtEndOfStream
                strName = ""
                strComputer = ""
                strComputer = objTextFile.Readline
                objExcel.Cells(x, 1).value = strComputer
y=7
 
                Set objShell = CreateObject("WScript.Shell")
                Set objExecObject = objShell.Exec ("%comspec% /c ping -n 1 -w 300 -a " & strcomputer)
                    strText = objExecObject.StdOut.ReadAll()
                    arrPingList = Split(strText , " ")
                    strText2 = arrPingList(1)
                    strText3 = arrPingList(2)
                If Instr(strText, "Reply") > 0 Then
        objExcel.Cells(x, 3).Value = "online"
 
        
        'Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
        Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
                If Err = 0 Then
                objExcel.Cells(x, 4).Value = "connected"
 
'Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colItems = objWMIService.ExecQuery("Select Name from Win32_ComputerSystem",,48)
                For Each objItem in colItems
                strName = objItem.Name
                Next
 
Set IPConfigSet = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
                For Each IPConfig in IPConfigSet
                                If Not IsNull(IPConfig.IPAddress) Then 
                For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)          
                                objExcel.Cells(x, y).value = IPConfig.IPAddress(i)
                y=y+1    
                                Next
                                End If
                Next
                
                objExcel.Cells(x, 2).value = strName       
                Else 
                objExcel.Cells(x, 4).Value = "cannot connect"
                objExcel.Cells(x, 5).value = strText2 
                objExcel.Cells(x, 6).value = strText3
                End If
                
                Else objExcel.Cells(x, 3).Value = "offline"
                objExcel.Cells(x, 4).Value = "cannot connect"
                objExcel.Cells(x, 5).value = strText2 
                objExcel.Cells(x, 6).value = strText3
                End If    
                
Err.Clear
x=x+1
 
Loop
objExcel.Close

wscript.quit

Function ChooseFile (ByVal initialDir)
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

    Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    Dim winVersion

    ' This collection should contain just the one item
    For Each objItem in colItems
        'Caption e.g. Microsoft Windows 7 Professional
        'Name e.g. Microsoft Windows 7 Professional |C:\windows|...
        'OSType e.g. 18 / OSArchitecture e.g 64-bit
        'Version e.g 6.1.7601 / BuildNumber e.g 7601
        winVersion = CInt(Left(objItem.version, 1))
    Next
    Set objWMIService = Nothing
    Set colItems = Nothing

    If (winVersion <= 5) Then
        ' Then we are running XP and can use the original mechanism
        Set cd = CreateObject("UserAccounts.CommonDialog")
        cd.InitialDir = initialDir
        cd.Filter = "ZIP files|*.zip|Text Documents|*.txt|Shell Scripts|*.*sh|All Files|*.*"
        ' filter index 4 would show all files by default
        ' filter index 1 would show zip files by default
        cd.FilterIndex = 1
        If cd.ShowOpen = True Then
            ChooseFile = cd.FileName
        Else
            ChooseFile = ""
        End If
        Set cd = Nothing    

    Else
        ' We are running Windows 7 or later
        Set shell = CreateObject( "WScript.Shell" )
        Set ex = shell.Exec( "mshta.exe ""about: <input type=file id=X><script>X.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(X.value);close();resizeTo(0,0);</script>""" )
        ChooseFile = Replace( ex.StdOut.ReadAll, vbCRLF, "" )

        Set ex = Nothing
        Set shell = Nothing
    End If
End Function    

Open in new window

0
 
LVL 14

Author Comment

by:Edward Pamias
ID: 39929390
It went all the way through with the exception of this error. See attached screen shot.
vb-script-error.jpg
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 39929554
Not really the focus of your question, but this should sort that error (it was obviously hidden with the on error statement).

Try this instead...objExcel.Application.Quit
0
 
LVL 14

Author Closing Comment

by:Edward Pamias
ID: 39929680
Thanks again for all your help.
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 39929844
Happy to help - thanx for the grade! :^)
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

There is an easy way, in .NET, to centralize the treatment of all unexpected errors. First of all, instead of launching the application directly in a Form, you need first to write a Sub called Main, in a module. Then, set the Startup Object to th…
Having just graduated from college and entered the workforce, I don’t find myself always using the tools and programs I grew accustomed to over the past four years. However, there is one program I continually find myself reverting back to…R.   So …
This tutorial will introduce the viewer to VisualVM for the Java platform application. This video explains an example program and covers the Overview, Monitor, and Heap Dump tabs.
The viewer will learn how to pass data into a function in C++. This is one step further in using functions. Instead of only printing text onto the console, the function will be able to perform calculations with argumentents given by the user.

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now