Solved

VB Script stopped working in Windows 7

Posted on 2014-03-14
10
1,441 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 15

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
NAS Cloud Backup Strategies

This article explains backup scenarios when using network storage. We review the so-called “3-2-1 strategy” and summarize the methods you can use to send NAS data to the cloud

 
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 15

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 15

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 15

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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
groupSumClump challenge 9 115
Show hidden user account 7 59
Using an encrypted  value to decrypt and display contents in vb6 9 52
Re-position the objects 7 109
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
The viewer will learn additional member functions of the vector class. Specifically, the capacity and swap member functions will be introduced.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

777 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