I'm new to vbscript. I get the error
Declaration expected at get_html
At the bottom part of my code. I am actually trying to declare a value (which is a url) for the variable get_html. How can I resolve this?
Module Module1
Sub Main()
End Sub
Sub get_html(ByVal up_http, ByVal down_http)
Dim xmlhttp : xmlhttp = CreateObject("msxml2.xmlhttp.3.0")
xmlhttp.open("get", up_http, False)
xmlhttp.send()
Dim fso : fso = CreateObject("scripting.filesystemobject")
Dim newfile : newfile = fso.createtextfile(down_http, True)
newfile.write(xmlhttp.responseText)
newfile.close()
newfile = Nothing
xmlhttp = Nothing
End Sub
get_html _"http://www.somwwebsite.com", _"c:\downloads\website.html"
End Module
There are some syntax mistakes.
Module statement is not part of VBScript.
Underscores can lead to unexpected results. See http://technet.microsoft.com/en-us/library/ee198844.aspx (search for the word underscore on page)
You can't use parentheses when calling a Sub (e.g. xmlhttp.open is a sub, does not return anything). You have two main alternatives to calling a sub routine. sub_proc param1, param2 or Call sub_proc(param1, param2)
The assignment operator '=' is not enough for the objects. You should
use Set statement. It assigns object references to the
variables.
The response may be return as utf-8 encoded. But however FSO is not at peace with utf-8. Another option is to write the response as unicode (passing True as third parameter to CreateTextFile)
but the output size will be larger than it should be. Therefore I would prefer to use Stream object.
I've revised your code. Please consider.
'Requeired Constants
Const adSaveCreateNotExist = 1 'only creates if not exists
Const adSaveCreateOverWrite = 2 'overwrites or creates if not exists
Const adTypeBinary = 1
Sub get_html(ByVal up_http, ByVal down_http)
Dim xmlhttp, varBody
Set xmlhttp = CreateObject("msxml2.xmlhttp.3.0")
xmlhttp.open "GET", up_http, False
xmlhttp.send
varBody = xmlhttp.responseBody
Set xmlhttp = Nothing
Dim str
Set str = CreateObject("Adodb.Stream")
str.Type = adTypeBinary
str.Open
str.Write varBody
str.SaveToFile down_http, adSaveCreateOverWrite
str.Close
Set str = Nothing
End Sub
get_html "http://stackoverflow.com", "c:\downloads\website.html"
You probably want to move your call to get_html to be a call from within your Main subroutine (Sub Main()). For example:
Sub Main()
get_html _"http://www.somwwebsite.com", _"c:\downloads\website.html"
End Sub
AFAIK, you can't make function calls from directly within a module.
Related
I could not figure out whats the problem is
Sub Reportstart(oEvent As Object)
Dim oFeld As Object
Dim oForm As Object
Dim oDocument As Object
Dim oDocView As Object
Dim Arg()
oField = oEvent.Source.Model
oForm = oField.Parent
sURL = oForm.DataSourceName
oDocument = StarDesktop.loadComponentFromURL(sURL, "C:\Users\Nameless\Desktop\Latest.odb", 0, Arg() )
oDocView = oDocument.CurrentController.Frame.ContainerWindow
oDocView.Visible = False
oDocument.getCurrentController().connect
Wait(100)
oDocument.ReportDocuments.getByName("report_student").open
oDocument.close(True)
End Sub'
The error is BASIC runtime error.
Argument is not optional.
Reportstart requires an argument oEvent, and the way you executed it, the subroutine was not given any argument.
The macro was designed to be called from an event handler of a control, for example, the Execute action of a push button on a Base form. Perhaps you executed the subroutine from the LibreOffice Basic IDE instead.
Related: https://ask.libreoffice.org/en/question/192344/argument-is-not-optional/
I am trying to write a function which will delete all sheets except the one passed as parameter. Below function is being called but function does not delete any sheets. How can I delete all worksheets except one?
........
Set ExcelObj = createobject("excel.application")
ExcelObj.Visible = true
Set ConfigFile = ExcelObj.Workbooks.Open (FilePath)
Set ConfigSheet = ConfigFile.Worksheets("Scripts")
Set ConfigApplicationSheet = ConfigFile.Worksheets("Applications")
Set ExecutiveSummarySheet = ConfigFile.Worksheets("Summary")
ExcelObj.ActiveWorkBook.SaveAs SummaryFilePath
DeleteSheet "ConfigScripSheet","Summary"
Function DeleteSheet(ConfigSheet,mySheetname)
'Writing Name and Path of each File to Output File
For Each ObjFile In ObjFiles
ObjOutFile.WriteLine(ObjFile.Name & String(50 - Len(ObjFile.Name), " ") & ObjFile.Path)
Next
ObjOutFile.Close
DeleteSheet = 0
ExcelObj.DisplayAlerts = False
For Each objWorksheet In ConfigSheet.Worksheets
If not objWorksheet.Name = mySheetname Then
DeleteSheet = 1
ConfigScripSheet.sheets(objWorksheet.Name).Select
ConfigScripSheet.sheets(objWorksheet.Name).Delete
ExcelObj.DisplayAlerts = False
End If
Next
End Function
Trying to correct your code above was too much of a minefield for me as I couldn't tell what you meant in several places - so I rewrote it based on what you had said in the description was your goal.
The code below will open the file, associate the objects the way you had them, pass the workbook object and a sheet name not to be deleted into the DeleteSheet function, which will delete any sheet in the workbook that is not named as per the passed in parameter SheetNameNotToDelete
Let me know if any of the code is unclear.
Option Explicit ' Forces declaration of variables
Dim FilePath, SummaryFilePath '<-- Need set to some value!
FilePath = ""
SummaryFilePath = ""
Dim ExcelObj : Set ExcelObj = CreateObject("Excel.Application")
Dim ConfigFile : Set ConfigFile = ExcelObj.Workbooks.Open(FilePath)
Dim ConfigSheet : Set ConfigSheet = ConfigFile.Worksheets("Scripts")
Dim ConfigApplicationSheet : Set ConfigApplicationSheet = ConfigFile.Worksheets("Applications")
Dim ExecutiveSummarySheet : Set ExecutiveSummarySheet = ConfigFile.Worksheets("Summary")
ExcelObj.ThisWorkbook.SaveAs SummaryFilePath
DeleteSheet ConfigFile, "Summary"
Function DeleteSheet(ByRef WorkbookObj, ByVal SheetNameNotToDelete)
Dim oWorksheet
For Each oWorksheet In WorkbookObj.Worksheets
If oWorksheet.Name <> SheetNameNotToDelete And WorkbookObj.Worksheets.Count >=2 Then
oWorksheet.Delete ' Excel won't let you delete all worksheets from a workbook
End If ' the check on Count >=2 covers the case where no worksheet exists
Next ' called "Summary" to be left
End Function
I implemented several functions which relies on downloading some information from some websites.
The simplest example of such a function is:
Public Function getSomething(webAddress As String)
Dim html As HTMLObjectElement
Set html = getWebContents(webAddress)
Set elems = html.body.getElementsByTagName(tagName)
...
End Function
The function for acquire data from websites is:
Public Function getWebContents(webAddress As String) As HTMLObjectElement
Dim ie As InternetExplorer
Dim html As HTMLDocument
Set ie = New InternetExplorer
ie.Visible = False
ie.Navigate webAddress
Do While ie.READYSTATE <> READYSTATE_COMPLETE
Application.StatusBar = "Trying ..."
DoEvents
Loop
Set getWebContents = ie.Document
'close down IE and reset status bar
'ie.Quit
Set ie = Nothing
Application.StatusBar = ""
End Function
The problem is that it seems that I need the line ie.Quit to be uncommented to close the IE instance. But when I uncomment ie.Quit the line
Set elems = html.body.getElementsByTagName(tagName)
generates errors.
It seems that I cannot use HTMLObjectElement returned by function getWebContents when IE has been quitted. How to deal with that? I could implement a try...finally block in getSomething function and open ie there and close in the finally block. However I have many functions of a similar nature and making many similar try...finally blocks seems a stupid idea.
Any thoughts?
Thanks!
You should define a procedure to handle the object lifetime from creation to destruction. You can then pass a reference for the object to the function.
Lastly, you can dispose the object even if an error occurs at any stange.
Public Sub Main()
On Error GoTo ErrProc
Dim ie As InternetExplorer
Set ie = New InternetExplorer
'....
Dim obj As Object
obj = getWebContents(ie, "url")
Leave:
ie.Quit
Set ie = Nothing
Set obj = Nothing
Application.StatusBar = ""
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
Public Function getWebContents(ie As InternetExplorer, webAddress As String) As HTMLObjectElement
'...
End Function
You are keeping a pointer to the DOM in the html variable. If you close IE, you are pointing to something non-existing.
The simple answer is to close IE at the end of getSomething. In your case, this means that you have to restructure your code so that your IE variable is accessible from other places than in getWebContents
I'm trying to get the address in
https://dev.virtualearth.net/REST/v1/Locations/40.6718266667,-73.7601944444?o=xml&key=AqF-lvBxcTAEbhY5v0MfOHxhplD5NyaznesQ1IA5KS_RNghU1zrDiYN704mlrc8A
That's the ("//Location/Name")
The code is :
Function FindALocationByPoint(Lat As String, Lon As String, BingMapsKey As String) As String
Dim myRequest As XMLHTTP60
Dim uu As String
uu = "https://dev.virtualearth.net/REST/v1/Locations/" & Lat & "," & Lon & "?o=xml&key=" & BingMapsKey
Set myRequest = New XMLHTTP60
myRequest.Open "POST", uu, 0
myRequest.send
FindALocationByPoint = myRequest.readyState
(I know the final line should be FindALocationByPoint = myRequest.responseXML.SelectNodes("//Location/Name").Item(0).Text) That will also return #VALUE! I think the main problem is the unsuccessful connection to the website.
Then the cell=FindALocationByPoint(K2,L2,$W$4)will return#VALUE!
If I delete myRequest.send then the cell will return 1, which means server connection established, right?
Then, why adding myRequest.send will return #VALUE! ?
Any Guidance?
THANK YOU SO MUCH. I've working with this for two days.
If I change the URL and set uu equals another Geocoding website, there is no problem.
So is there something wrong with the website?(Microsoft Bing)
But I must use Bing, how to deal with this?
Thanks,
Ajax is not the problem here. You can load and use the long path to access:
Option Explicit
Public Sub test()
Const URL As String = "https://dev.virtualearth.net/REST/v1/Locations/40.6718266667,-73.7601944444?o=xml&key=AqF-lvBxcTAEbhY5v0MfOHxhplD5NyaznesQ1IA5KS_RNghU1zrDiYN704mlrc8A"
Dim sResponse As String, xmlDoc As Object 'MSXML2.DOMDocument60
With CreateObject("MSXML2.ServerXMLHTTP")
.Open "GET", URL, False
.send
sResponse = .responseText
End With
Set xmlDoc = CreateObject("MSXML2.DOMDocument") 'New MSXML2.DOMDocument60
With xmlDoc
.validateOnParse = True
.setProperty "SelectionLanguage", "XPath"
.async = False
If Not .LoadXML(sResponse) Then
Err.Raise .parseError.ErrorCode, , .parseError.reason
End If
Dim a As IXMLDOMElement
Set a = .LastChild.LastChild.FirstChild.LastChild.FirstChild.FirstChild
Debug.Print a.nodeTypedValue
End With
End Sub
If you execute the following script, it wll print you the same addresse twice dug out from different nodes. Let me know if this is what you expected or I got you wrong.
Sub GetAddress()
Const URL$ = "https://dev.virtualearth.net/REST/v1/Locations/40.6718266667,-73.7601944444?o=xml&key=AqF-lvBxcTAEbhY5v0MfOHxhplD5NyaznesQ1IA5KS_RNghU1zrDiYN704mlrc8A"
Dim xmlDoc As Object, elem$, elemAno$
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
xmlDoc.LoadXML .responseXML.XML
End With
elem = xmlDoc.SelectNodes("//Location/Name")(0).Text
elemAno = xmlDoc.SelectNodes("//Address/FormattedAddress")(0).Text
Debug.Print elem, elemAno
End Sub
I have 2 vbs files.
A.vbs:
Class test
public a
public b
End Class
B.vbs:
Dim objShell
Set objShell = Wscript.CreateObject("WScript.Shell")
objShell.Run "C:\Users\shanmugavel.chinnago\Desktop\Test3.vbs"
Dim ins
Set ins = new test 'Here throws "Class not defined: test"
ins.a = 10
ins.b = "SCS"
msgbox ins.a
msgbox ins.b
Now I want to achive this like in B.vbs file. But it throws error while creating instance for the class availble in A.vbs. Any help?
.Running a .vbs won't make the code usable in another one. A simple but extensible strategy is to use .ExecuteGlobal on the 'libraries'. Given
Lib.vbs:
' Lib.vbs - simple VBScript library/module
' use
' ExecuteGlobal goFS.OpenTextFile(<PathTo\Lib.vbs>).ReadAll()
' to 'include' Lib.vbs in you main script
Class ToBeAShamedOf
Public a
Public b
End Class ' ToBeAShamedOf
and main.vbs:
' main.vbs - demo use of library/module Lib.vbs
' Globals
Dim gsLibDir : gsLibDir = ".\"
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
' LibraryInclude
ExecuteGlobal goFS.OpenTextFile(goFS.BuildPath(gsLibDir, "Lib.vbs")).ReadAll()
WScript.Quit main()
Function main()
Dim o : Set o = New ToBeAShamedOf
o.a = 4711
o.b = "whatever"
WScript.Echo o.a, o.b
main = 1 ' can't call this a success
End Function ' main
you'll get:
cscript main.vbs
4711 whatever
(cf. this answer for a seed of a useful class)
Your b script doesn't have contact with youyr a script, you need to include the code like so, then you can use code from a like it were present in b
call Include("a.vbs")
Sub Include (Scriptnaam)
Dim oFile
Set oFile = oFso.OpenTextFile(Scriptnaam)
ExecuteGlobal oFile.ReadAll()
oFile.Close
End Sub
This is the code that we use to do this.
Sub Include(sInstFile)
Dim f, s, oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
If oFSO.FileExists(sInstFile) Then
Set f = oFSO.OpenTextFile(sInstFile)
s = f.ReadAll
f.Close
ExecuteGlobal s
End If
On Error Goto 0
Set f = Nothing
Set oFSO = Nothing
End Sub
Include("c:\files\SSDConnection.vbs")
Include("c:\files\SSDTable.vbs")
Works flawless for our team
You can convert B.vbs into a Windows Script File which will allow you to include A.vbs.