Please help. cant make this code work. It requires an object. Don't know how to resolve this. I see no typo error on my script. I am trying to check if there is an Internet Explorer that is open to https://www.test.com in my PC. Badly needed for a school project. Thanks in advance
Option Explicit
Dim objShell, objShellWindows, i, objIE
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
For i = 0 to objShellWindows.Count - 1
Set objIE = objShellWindows.Item(i)
strURL = objIE.LocationURL
If InStr(strURL, "https://www.test.com/")Then
blnFound = True
End If
Next
Below code will check all the URLs loaded in the IE,
Note that here bFound is True when sURL is inside .LocationURL, not begin with. Modify to suit your need.
Option Explicit
Const sURL = "https://www.test.com/"
Dim oShell, oWindow, oIE, bFound
Set oShell = CreateObject("Shell.Application")
bFound = False
For Each oWindow In oShell.Windows
If InStr(1,oWindow.Fullname,"iexplore.exe",vbTextCompare) > 0 Then
Set oIE = oWindow
With oIE
'Wscript.Echo .LocationURL
bFound = (InStr(1,.LocationURL,sURL,vbTextCompare) > 0)
If bFound Then Exit For
End With
Set oIE = Nothing
End If
Next
If bFound Then
Wscript.Echo sURL & " is loaded"
Else
Wscript.Echo sURL & " is NOT loaded"
End If
Set oShell = Nothing
Related
I am trying to get a .vbs to download files from google drive as I have had it working as a macro inside excel. It would just be overall easier without needing to go into excel to run the script. I have tried to Frankenstein the working code within the macro which downloads the file to downloads with some other but have got lost. I am still a rookie so if the code is less than ideal would appreciate some feedback.
As a note: The userprofile was attempted to be set as variable for multiple users with differently mapped download folders to still run it.
Ran macro in excel which achieved downloading the file.
Tried to create .vbs with similar code and failed
Option Explicit
Dim FileNum
Dim FileData
Dim MyFile
Dim WHTTP
Dim strDisplayName
Dim oShell
Dim strHomeFolder
Dim vbDirectory
Dim dir
Set oShell = CreateObject("WScript.Shell")
strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
'Set strDisplayName = CreateObject("Scripting.FileSystemObject")
'Set objAD = CreateObject("ADSystemInfo")
'Set objUser = GetObject("LDAP://" & objAD.UserName)
'strDisplayName = objUser.DisplayName
On Error Resume Next
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0
MyFile = "https://drive.google.com/open?id=1Hx5DymjrhaiM8Rb7NMP_Sde_JU2N2Rau"
WHTTP.Open "GET", MyFile, False
WHTTP.send
'On Error Resume Next
FileData = WHTTP.ResponseBody
Set WHTTP = Nothing
If Dir(strHomeFolder & "\Downloads", vbDirectory) = Empty Then MkDir strHomeFolder & "\Downloads"
Dim xlApp, xlBook
Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
Set xlBook = xlApp.Workbooks.Open(strHomeFolder & "\Downloads\External Linking.xlsm", 0, True)
'D:\Users\cdoyle\Desktop\External linking.xlsm
'https://drive.google.com/open?id=1Hx5DymjrhaiM8Rb7NMP_Sde_JU2N2Rau
'"C:\Users\ciara\OneDrive\BayswaterBridge.xlsm"'
xlApp.Run "BridgeHit"
'xlbook.Save False
xlBook.Close False
set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
'WScript.Echo "Finished."
WScript.Quit
Keep getting some errors on If Dir(
line and seem to be chasing my tail.
It is my first vbs experience.
I try to keep my Problem short.
This one works, when I run it with my .bat:
Option Explicit
On Error Resume Next
ExcelMacroExample
Sub ExcelMacroExample()
Dim xlApp
Dim xlBook
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("C:\.....\RunScript.xlsm", 0,
True)
xlApp.Run "Auto_Open"
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
And this one works (shows me my corect current directory with my file):
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
sScriptDir = oFSO.GetParentFolderName(WScript.ScriptFullName)
Wscript.Echo sScriptDir & "\RunScript.xlsm"
But if I combine them, it does not work:
Option Explicit
On Error Resume Next
ExcelMacroExample
Sub ExcelMacroExample()
Dim xlApp
Dim xlBook
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
sScriptDir = oFSO.GetParentFolderName(WScript.ScriptFullName)
Set fileDirectory = sScriptDir & "\RunScript.xlsm"
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(fileDirectory, 0,
True)
xlApp.Run "Auto_Open"
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Like I said, thank you Dave. That works.
However I found another issue, now with vbA inside the RunScript.xlsm
This code works with the vbS before:
Sub Auto_Open()
Application.DisplayAlerts = False
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:= _
"C:\...\MyCSV.csv" _
, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
ThisWorkbook.Saved = True
Application.Quit
End Sub
But if I change here the path, it just works when I run the RunScript.xlsm, but not when I run my vbS:
Sub Auto_Open()
Application.DisplayAlerts = False
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
Dim relativePath As String
relativePath = Application.ActiveWorkbook.path & "\MyCSV.csv"
ActiveWorkbook.SaveAs Filename:=relativePath, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
ThisWorkbook.Saved = True
Application.Quit
End Sub
I think it is beacause of the ActiveWorkbook, I tried already ThisWorkbook, and I tried it without Application.
What I am trying to do is to open an Excel file on a certain worksheet, from a PDF generated by LaTeX, by including \href{run:./xx.xls}.
I found the VBScript code below (by #brettdj) very helpful to open a .vbs file with a specified file name.
But how to make the code accept a parameter (to open a different file) each time it is executed, instead of specifying a file name in strFileName?
Const xlVisible = -1
Dim objExcel
Dim objWb
Dim objws
Dim strFileName
strFileName = "E:RoomContentsAll.xls"
On Error Resume Next
Set objExcel = CreateObject("excel.application")
Set objWb = objExcel.Workbooks.Open(strFileName)
Set objws = objWb.Sheets(2)
On Error GoTo 0
If Not IsEmpty(objws) Then
If objws.Visible = xlVisible Then
objExcel.Goto objws.Range("a1")
Else
wscript.echo "the 2nd sheet is present but is hidden"
End If
objExcel.Visible = True
Else
objExcel.Quit
Set objExcel = Nothing
If IsEmpty(objWb) Then
wscript.echo strFileName & " not found"
Else
wscript.echo "sheet2 not found"
End If
End If
WScript.Arguments(0) is the first parameter, (1) is the second, etc, etc
Const xlVisible = -1
Dim objExcel
Dim objWb
Dim objws
Dim strFileName
strFileName = WScript.Arguments(0)
On Error Resume Next
Set objExcel = CreateObject("excel.application")
Set objWb = objExcel.Workbooks.Open(strFileName)
Set objws = objWb.Sheets(2)
On Error GoTo 0
If Not IsEmpty(objws) Then
If objws.Visible = xlVisible Then
objExcel.Goto objws.Range("a1")
Else
wscript.echo "the 2nd sheet is present but is hidden"
End If
objExcel.Visible = True
Else
objExcel.Quit
Set objExcel = Nothing
If IsEmpty(objWb) Then
wscript.echo strFileName & " not found"
Else
wscript.echo "sheet2 not found"
End If
End If
I have been given a task of creating a script that takes a log file (date is in the filename), pulls the data and posts it in event manager. I have a script that works as it should I know the script is ugly so please be gentle. I'm looking for 2 things.
some days nothing has happened and no log for the day was created. when this happens my script causes all kinds of slowness in the PC. I need help with a way for the script to not do its task if no new file has been added to the logs folder.
I would like a little help cleaning up the script.
Like i said i'm very new to this and i used scripts found on the web and fit them to do what i needed them to do.
any help would be greatly appricated.
Option Explicit
Const ForReading = 1
Dim strfolder
Dim FSO
Dim FLD
Dim fil
Dim strOldName
Dim strNewName
Dim strFileParts
Dim objShell
Dim objFSO
Dim objFolder
Dim strFileName
Dim objFile
Dim objTextFile
Dim strNextLine
Dim arrServiceList
Dim i
strFolder = "C:\Logs\"
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolder)
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile ("C:\Logs\logCatchAll.log", ForReading)
For Each strFileName in objFolder.Items
If len(objFSO.GetExtensionName(strFileName)) > 0 Then
Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
If DateDiff("H",objFile.DateLastModified,Now()) > 24 Then
objFSO.DeleteFile(strFolder & strFileName.Name),True
End If
End If
next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLD = FSO.GetFolder(strfolder)
For Each fil in FLD.Files
strOldName = fil.Path
If InStr(strOldName, "-") > 0 Then
strFileParts = Split(strOldName, "-")
strNewName = strFileParts(0) & ".log"
FSO.MoveFile strOldName, strNewName
End If
Next
Set FLD = Nothing
Set FSO = Nothing
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
arrServiceList = Split(strNextLine , ",")
For i = 3 to Ubound(arrServiceList)
objshell.LogEvent 4, arrServiceList(i)
Loop
You can block your Dim'd variables
You are reactivating the objShell to many times
You have a for loop at the bottom of your code without a Next statement.
You don't need to iterate through the log file until it reaches AtEndOfStream, just store it in a variable first.
You can use the same objFSO more than once if your not resetting the object.
You need to include error handling so you know where your code breaks.
Revised code.
Option Explicit
'Handle errors manually.
On Error Resume Next
'Set Constants
Const ForReading = 1
'Set Strings
Dim strFolder, strOldName, strNewName, strFileName, strFileParts, strNextLine, TFStrings
strFolder = "C:\Logs\"
'Set Objects
Dim objShell, objFSO, objFolder, objFile, objTextFile
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objShell.Namespace(strFolder)
TFStrings = split(objFSO.OpenTextFile("C:\Logs\logCatchAll.log", ForReading).ReadAll, vbcrlf)
'Set Other Variables
Dim FLD, fil, arrServiceList, i, executed
executed = false
'Delete file procedure...
For Each strFileName in objFolder.Items
If len(objFSO.GetExtensionName(strFileName)) > 0 Then
Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
If DateDiff("H",objFile.DateLastModified,Now()) > 24 Then
objFSO.DeleteFile(strFolder & strFileName.Name),True
executed = true
End If
End If
Next
If executed then
If err.number <> 0 then
'File was found, but delete was unsuccessful, log failure of delete.
executed = false
err.clear
Else
'Delete file procedure executed successfully. Lets move on.
executed = false
End If
Else
'No file was found within the conditions. log failure of search.
End if
'Move file and rename procedure...
Set FLD = objFSO.GetFolder(strfolder)
For Each fil in FLD.Files
strOldName = fil.Path
If InStr(strOldName, "-") > 0 Then
strFileParts = Split(strOldName, "-")
strNewName = strFileParts(0) & ".log"
objFSO.MoveFile strOldName, strNewName
executed = true
End If
Next
Set FLD = Nothing
Set FSO = Nothing
If executed then
If err.number <> 0 then
'File was found, but move was unsuccessful, log failure of move.
executed = false
err.clear
Else
'Move file procedure executed successfully. Lets move on.
executed = false
End If
Else
'No file was found within the conditions. log failure of search.
End if
For Each line in TFStrings
strNextLine = line
arrServiceList = Split(strNextLine , ",")
For i = 3 to Ubound(arrServiceList)
objshell.LogEvent 4, arrServiceList(i)
Next
Next
How can I check for registry value using VbScript?
Function ReadFromRegistry(strRegistryKey, strDefault)
Dim WSHShell, value
On Error Resume Next
Set WSHShell = CreateObject("WScript.Shell")
value = WSHShell.RegRead( strRegistryKey )
If err.number <> 0 Then
readFromRegistry = strDefault
Else
readFromRegistry = value
End If
Set WSHShell = Nothing
End Function
Usage :
str = ReadfromRegistry("HKEY_LOCAL_MACHINE\SOFTWARE\Adobe\ESD\Install_Dir", "ha")
WScript.echo "returned " & str
Original post
Try something like this:
Dim windowsShell
Dim regValue
Set windowsShell = CreateObject("WScript.Shell")
regValue = windowsShell.RegRead("someRegKey")
This should work for you:
Dim oShell
Dim iValue
Set oShell = CreateObject("WScript.Shell")
iValue = oShell.RegRead("HKLM\SOFTWARE\SOMETHINGSOMETHING")
Try this. This script gets current logged in user's name & home directory:
On Error Resume Next
Dim objShell, strTemp
Set objShell = WScript.CreateObject("WScript.Shell")
strTemp = "HKEY_CURRENT_USER\Volatile Environment\USERNAME"
WScript.Echo "Logged in User: " & objShell.RegRead(strTemp)
strTemp = "HKEY_CURRENT_USER\Volatile Environment\USERPROFILE"
WScript.Echo "User Home: " & objShell.RegRead(strTemp)
Set objShell = WScript.CreateObject("WScript.Shell")
skey = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\{9A25302D-30C0-39D9-BD6F-21E6EC160475}\"
with CreateObject("WScript.Shell")
on error resume next ' turn off error trapping
sValue = .regread(sKey) ' read attempt
bFound = (err.number = 0) ' test for success
end with
if bFound then
msgbox "exists"
else
msgbox "not exists"
End If