Avatar of Edward Pamias
Edward PamiasFlag for United States of America

asked on 

How do I get my VB script to ask for elvated credentials.

All,

2 things with this script, it stops once it runs into a PC that is not online. I want it to continue on even if it fails to connect. It use to work but it's not working like it use to. Second I want it to ask for my elevated credentials when I first run it.

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
VB ScriptScripting LanguagesVisual Basic.NETVisual Basic ClassicProgramming

Avatar of undefined
Last Comment
Edward Pamias
ASKER CERTIFIED SOLUTION
Avatar of darbid73
darbid73
Flag of Germany image

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
SOLUTION
Avatar of Hackoo
Hackoo
Flag of Tunisia image

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
Avatar of Edward Pamias
Edward Pamias
Flag of United States of America image

ASKER

Thanks all!
Visual Basic Classic
Visual Basic Classic

Visual Basic is Microsoft’s event-driven programming language and integrated development environment (IDE) for its Component Object Model (COM) programming model. It is relatively easy to learn and use because of its graphical development features and BASIC heritage. It has been replaced with VB.NET, and is very similar to VBA (Visual Basic for Applications), the programming language for the Microsoft Office product line.

165K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews

TRUSTED BY

IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo