Solved

VB Script stopped working in Windows 7

Posted on 2014-03-14
10
1,453 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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 17

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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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 17

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
 
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 17

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 17

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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
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 clear a vector as well as how to detect empty vectors in C++.

737 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