• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1509
  • Last Modified:

VB Script stopped working in Windows 7

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
Edward Pamias
Asked:
Edward Pamias
  • 6
  • 4
1 Solution
 
sirbountyCommented:
Try changing this line:
Set objDialog = CreateObject("UserAccounts.CommonDialog")
into this one:
Set objDialog = CreateObject("MSComDlg.CommonDialog")
0
 
Edward PamiasTeam Lead RRS DeskAuthor Commented:
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
 
sirbountyCommented:
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
sirbountyCommented:
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
 
Edward PamiasTeam Lead RRS DeskAuthor Commented:
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
 
sirbountyCommented:
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
 
Edward PamiasTeam Lead RRS DeskAuthor Commented:
It went all the way through with the exception of this error. See attached screen shot.
vb-script-error.jpg
0
 
sirbountyCommented:
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
 
Edward PamiasTeam Lead RRS DeskAuthor Commented:
Thanks again for all your help.
0
 
sirbountyCommented:
Happy to help - thanx for the grade! :^)
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 6
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now