I'm running a web-based slideshow on multiple computer units. I have a VBScript that runs on startup, opens IE and navigates to a specific page in fullscreen mode. Everything works great, as long as there's an internet connection on startup. If there isn't then the page never loads. Is there a way in VBScript to check for a connection every couple minutes until the connection is found, and then continue with the script? Here is the code for your reference:
Option Explicit
Dim WshShell
set WshShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
With WScript.CreateObject ("InternetExplorer.Application")
.Navigate "http://www.example.com/slideshow"
.fullscreen = 1
.Visible = 1
WScript.Sleep 10000
End With
On Error Goto 0
Refer to this ==> Loop a function?
Yes, you can do it easily with this code :
Option Explicit
Dim MyLoop,strComputer,objPing,objStatus
MyLoop = True
While MyLoop = True
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
MyLoop = False
Call MyProgram()
wscript.quit
End If
Next
Pause(10) 'To sleep for 10 secondes
Wend
'**********************************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
Sub MyProgram()
Dim WshShell
set WshShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
With WScript.CreateObject ("InternetExplorer.Application")
.Navigate "http://www.example.com/slideshow"
.fullscreen = 1
.Visible = 1
WScript.Sleep 10000
End With
On Error Goto 0
End Sub
'**********************************************************************************************
If Hackoo's code doesn't work for you, you can try the following. Not all servers will respond to ping requests but you could just make an HTTP request and see if the server sends a valid response (status = 200).
Function IsSiteReady(strURL)
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", strURL, False
.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.1)"
On Error Resume Next
.Send
If .Status = 200 Then IsSiteReady = True
End With
End Function
Related
Below code is to check whether a network connection on the machine is established.
Dim T = 0
While(T = 0)
Set Http = WScript.CreateObject("MSXML2.ServerXMLHTTP")
Http.Open "GET", "http://www.google.com/", True
Http.Send
If(Http.Status = 200) Then
MsgBox "Network Connection is established"
T = 1
else
MsgBox "Network Connection isn't established yet"
End If
Wend
Whether or not network is connected, the Http.Status returns value 200.
Could anyone assist whether I'm missing anything here.
Refer to this ==> Loop a function?
You can do it easily with this code :
Option Explicit
Dim MyLoop,strComputer,objPing,objStatus
MyLoop = True
While MyLoop = True
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
MyLoop = False
Call MyProgram()
wscript.quit
End If
Next
Pause(10) 'To sleep for 10 secondes
Wend
'**********************************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
Sub MyProgram()
Dim WshShell
set WshShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
With WScript.CreateObject ("InternetExplorer.Application")
.Navigate "http://www.example.com/slideshow"
.fullscreen = 1
.Visible = 1
WScript.Sleep 10000
End With
On Error Goto 0
End Sub
'**********************************************************************************************
EDIT :
Wscript.echo(CheckConnection("https://www.google.com"))
'----------------------------------------------------
Function CheckConnection(URL)
On Error Resume Next 'swallow errors
Set o = CreateObject("MSXML2.XMLHTTP")
o.open "GET",URL, False
o.send
If Err.Number <> 0 Then
CheckConnection = "An error occured. Data not retrieved."
'or whatever else you want to do in such a case.
Else
CheckConnection = "You are connected"
End If
On Error Goto 0 'back to normal error behaviour
End Function
'----------------------------------------------------
Can somebody help with this script I am using for closing/terminating SAP Workbook? This worked for a long time until the time that the company updated our MS Office to a new version (MS Office 365 ProPlus). The intention of this code is to force close a certain SAP generated spreadsheets that keeps on auto-pop up when extracting a SAP reports. This old code was shared by #ScriptMan before in this forum.
SAP_Workbook = "ZZFRAR080_EXTRACTED.XLSX"
on error resume next
do
err.clear
Set xclApp = GetObject(, "Excel.Application")
If Err.Number = 0 Then exit do
'msgbox "Wait for Excel session"
wscript.sleep 2000
loop
do
err.clear
Set xclwbk = xclApp.Workbooks.Item(SAP_Workbook)
If Err.Number = 0 Then exit do
wscript.sleep 2000
loop
on error goto 0
Set xclSheet = xclwbk.Worksheets(1)
xclApp.Visible = True
xclapp.DisplayAlerts = false
xclapp.ActiveWorkbook.Close
Set xclwbk = Nothing
Set xclsheet = Nothing
'xclapp.Quit
set xclapp = Nothing
Based on my initial checking, the issue is found in this part as it keeps on looping endlessly (detected it by putting a MsgBox after the loop). I have noticed that the new version of Excel 2016 makes the generated spreadsheets as new instance/session like it keeps on creating new Excel.exe in the process tab.
do
err.clear
Set xclwbk = xclApp.Workbooks.Item(SAP_Workbook)
If Err.Number = 0 Then exit do
wscript.sleep 2000
loop
You could try the following:
SAP_Workbook = "ZZFRAR080_EXTRACTED.XLSX"
Set Wshell = CreateObject("WScript.Shell")
Wshell.Run "c:\tmp\SAP_Workbook_Close.vbs" & " " & SAP_Workbook, 1, False
. . .
SAP_Workbook_Close.vbs:
myFileName = wscript.arguments(0)
on error resume next
do
err.clear
Set xclApp = GetObject(, "Excel.Application")
'xclApp.WindowState = -4140 'xlMinimized
If Err.Number = 0 Then exit do
'msgbox "Wait for Excel session"
wscript.sleep 2000
loop
do
err.clear
Set xclwbk = xclApp.Workbooks.Item(myFileName)
'xclApp.WindowState = -4140 'xlMinimized
If Err.Number = 0 Then exit do
'msgbox "Wait for SAP workbook"
wscript.sleep 2000
loop
on error goto 0
Set xclSheet = xclwbk.Worksheets(1)
xclapp.ActiveWorkbook.Close
xclApp.Visible = True
xclapp.DisplayAlerts = false
'xclApp.WindowState = -4143 'xlNormal
Set xclwbk = Nothing
Set xclsheet = Nothing
'xclapp.Quit
set xclapp = Nothing
Regards,
ScriptMan
I have here a VBScript to "toggle" my network adapter (built from a script found on the Internet).
I was wondering if maybe someone can help me convert it to a script that can "reset" (disable, then re-enable) my wireless adapter, rather than toggle it.
'~ Toggle a SPECIFIED NIC on or off
Option Explicit
Const NETWORK_CONNECTIONS = &H31&
Dim objShell, objFolder, objFolderItem, objEnable, objDisable
Dim folder_Object, target_NIC
Dim NIC, clsVerb
Dim str_NIC_Name, strEnable, strDisable
Dim bEnabled, bDisabled
'NIC name goes here VVV
str_NIC_Name = "Wi-Fi"
strEnable = "En&able"
strDisable = "Disa&ble"
' create objects and get items
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(NETWORK_CONNECTIONS)
Set objFolderItem = objFolder.Self
Set folder_Object = objFolderItem.GetFolder
Set target_NIC = Nothing
' look at each NIC and match to the chosen name
For Each NIC In folder_Object.Items
If LCase(NIC.Name) = LCase(str_NIC_Name) Then
' proper NIC is found, get it
Set target_NIC = NIC
End If
Next
bEnabled = True
Set objEnable = Nothing
Set objDisable = Nothing
For Each clsVerb In target_NIC.Verbs
'~ Wscript.Echo clsVerb
If clsVerb.Name = strEnable Then
Set objEnable = clsVerb
bEnabled = False
End If
If clsVerb.Name = strDisable Then
Set objDisable = clsVerb
End If
Next
If bEnabled Then
objDisable.DoIt
Else
objEnable.DoIt
End If
'~ Give the connection time to change
WScript.Sleep 5000
I think it's better to use WMI (Windows Management Instrumentation).
Here is a sample script:
Option Explicit
dim ComputerName
dim WMIService, NIC
dim ConnectionName
ComputerName = "."
ConnectionName = "Ethernet"
if not IsElevated then
WScript.Echo "Please run this script with administrative rights!"
WScript.Quit
end if
On Error Resume Next
Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2")
Set NIC = WMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapter WHERE NetConnectionID = '" & ConnectionName & "'").ItemIndex(0)
if NIC is nothing then
WScript.Echo "NIC not found!"
WScript.quit
end if
WScript.Echo "NIC Current status: " & iif(NIC.NetEnabled, "Enabled", "Disabled") & vbcrlf
if NIC.NetEnabled then
WScript.Echo "Disabling NIC..."
NIC.Disable
WScript.Sleep 1000
WScript.Echo "Enabling NIC..."
NIC.Enable
end if
function iif(cond, truepart, falsepart)
if cond then iif=truepart else cond=falsepart
end function
function IsElevated()
On Error Resume Next
CreateObject("WScript.Shell").RegRead("HKEY_USERS\s-1-5-19\")
IsElevated = (err.number = 0)
end function
I am trying to make a script which pings an IP address until it receives a response. When it does, it launches another script called "sound.vbs". I've got 2 issues:
I don't
want the cmd window to pop up when ping command is executed.
Even when ping fails, script simply shuts down instead of waiting some time and retrying the ping.
Code:
Dim objShell
Set objShell = Wscript.CreateObject("WScript.Shell")
Dim target 'define target ip
Dim result 'define ping result
target= "193.105.173.130" 'Archeage EU server IP (possibly Shatigon)
result = "Request timed out" 'Initial result
Set shell = WScript.CreateObject("WScript.Shell") 'create WScript shell
Set shellexec = shell.Exec("ping " & target) 'setting up the ping
Dim count
count = 1
Do
result = LCase(shellexec.StdOut.ReadAll)
If InStr(result , "reply from") Then
objShell.Run "sound.vbs"
Set objShell = Nothing
count = count + 1
Else
WScript.Sleep 4000
End If
Loop until count < 2
How do I solve the listed issues?
You can try like this script just modify to yours :
Option Explicit
Dim strComputer,objPing,objStatus
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
Call MyProgram()
wscript.quit
End If
Next
'****************************************************
Sub MyProgram()
Dim objShell
Set objShell = CreateObject( "WScript.Shell" )
objShell.Run("calc.exe")
Set objShell = Nothing
End Sub
'****************************************************
Inspired from Loop a function?
If StrComp(right(WScript.FullName,11),"wscript.exe",1) = 0 Then '' hide the popup of cmd windows
WScript.Quit CreateObject("WScript.Shell").Run("cscript.exe //nologo """ & WScript.ScriptFullName & """", 0, False)
End If
Dim target 'define target ip
Dim result 'define ping result
target= "8.8.8.8" 'Archeage EU server IP (possibly Shatigon)
result = "Request timed out" 'Initial result
Dim Shell
Set Shell = WScript.CreateObject("WScript.Shell") 'create WScript shell
Dim count
count = 1
Do
Set shellexec = Shell.Exec("ping " & target) 'setting up the ping
result = LCase(shellexec.StdOut.ReadAll)
If InStr(1,result , "TTL=",1)> 0 Then
Shell.Run "sound.vbs",0,False
Exit Do
Else
WScript.Sleep 4000
count = count + 1
End If
Loop Until count > 2
Set Shell = Nothing
WScript.Quit
1-The first 3 line of code hide the popup of command line windows
2-exec the ping command have to done inside do loop not out so you will have second retry if first ping fail
3- Use TTL= instead of replay from (localhost or router can send replay from while target not reachable )
4- until > 2 not less than (infinity loop)
I'm not a programmer so I don't want to overly irritate the fine folk in this forum. My issue is that I would like to use VBScript to Telnet into a Linux device, issue a DF command and output all response to a log file which I can parse later. I originally found a method to successfully Telnet but I have have been experimenting without success regarding the text file output requirement. The following code certainly does not work but I am wondering if I am even close to the correct method?
Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("cmd /c dir")
WshShell.run"cmd" '*** open command window ***
WScript.Sleep 250
WshShell.SendKeys("{Enter}")
WshShell.SendKeys"telnet 10.13.2.2"
WshShell.SendKeys("{Enter}")
WScript.Sleep 2000
WshShell.SendKeys"root"
WshShell.SendKeys("{Enter}")
WScript.Sleep 1500
WshShell.SendKeys"password"
WshShell.SendKeys("{Enter}")
WScript.Sleep 1500
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFSO.OpenTextFile("C:\VBSmemSize.txt", 2, True)
WshShell.SendKeys"df /mnt/cf"
WshShell.SendKeys("{Enter}")
Do
strFromProc = oExec.Stdout.Readline()
WScript.Echo strFromProc
Loop While Not objLogFile.StdOut.atEndOfStream
You can capture output from external commands but not at the same time interact with them like you do with sendkeys. Here an example of what works
Function ExecPing(strTarget)
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("ping -n 2 -w 1000 " & strTarget)
strPingResults = LCase(objExec.StdOut.ReadAll)
If InStr(strPingResults, "antwoord van") Then '"reply from" in E
WScript.Echo VbCrLf & strTarget & " responded to ping."
ExecPing = True
Else
WScript.Echo VbCrLf & strTarget & " did not respond to ping."
ExecPing = False
End If
End Function
ExecPing pcname