I built some code to retrieve stock data from Yahoo as a CSV file, and it works fine. When I change the URL to the perfectly legal version that recalls minutewise data from Google instead, it fails on the
objHTTP.open "GET", strURL, False
statement.
The following code shows both URLs, although obviously only the final one is called. Both URLs work when posted into the address bar of a browser.
Can anyone explain why the call to Google's page won't Open?
option explicit
Dim objHTTP
dim strURL
dim objFile
dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
' WORKS:
strURL = "http://real-chart.finance.yahoo.com/table.csv?s=UPRO&a=04&b=21&c=2016&d=04&e=31&f=2016&g=d&ignore=.csv"
' DOES NOT WORK:
strURL = "www.google.com/finance/getprices?q=UPRO&i=60&p=20d&f=d,c,v,k,o,h,l&df=cpct&auto=0&ei=Ef6XUYDfCqSTiAKEMg"
objHTTP.open "GET", strURL, False
objHTTP.send
msgbox objHTTP.responseText
Set objFile = objFSO.CreateTextFile _
("Yahoo.csv", 2)
objFile.Write objHTTP.ResponseText
objFile.Close
You are missing http:// from the broken URL. When I added this, I got response data.
Related
The bounty expires in 4 days. Answers to this question are eligible for a +50 reputation bounty.
HelloCW is looking for an answer from a reputable source.
I'm a beginner of vbs, the Code A is written using vbs, it works well.
I find there are many repeated code in Code A, how to optimize the vbs code ?
Code A
Call Send_HTTP_RequestA()
Call Send_HTTP_RequestB()
Sub Send_HTTP_RequestA()
'Force the script to finish on an error.
On Error Resume Next
'Declare variables
Dim objRequest
Dim URL
Set objRequest = CreateObject("Microsoft.XMLHTTP")
'Put together the URL link appending the Variables.
URL = "http://www.a.com/Task.aspx"
'Open the HTTP request and pass the URL to the objRequest object
objRequest.open "POST", URL , false
'Send the HTML Request
objRequest.Send
'Set the object to nothing
Set objRequest = Nothing
End Sub
Sub Send_HTTP_RequestB()
'Force the script to finish on an error.
On Error Resume Next
'Declare variables
Dim objRequest
Dim URL
Set objRequest = CreateObject("Microsoft.XMLHTTP")
'Put together the URL link appending the Variables.
URL = "http://www.b.com/task.aspx?From=VPSScedule&ForceRun=True"
'Open the HTTP request and pass the URL to the objRequest object
objRequest.open "POST", URL , false
'Send the HTML Request
objRequest.Send
'Set the object to nothing
Set objRequest = Nothing
End Sub
Added Content
Thank you all! Is Code B correct?
Code B
Send_HTTP_Request "http://www.1.com/Task.aspx"
Send_HTTP_Request "http://www.2.com/task.aspx?From=VPSScedule&ForceRun=True"
Sub Send_HTTP_Request(URL)
On Error Resume Next
Dim objRequest
Set objRequest = CreateObject("Microsoft.XMLHTTP")
objRequest.open "POST", URL , false
objRequest.Send
Set objRequest = Nothing
End Sub
I'm trying to write a VBScript that looks navigates a website based on the content of that website. To do that, I need to be able to assign the source code of each web page to a string variable and have the script look through that string for certain words.
I have seen this proposed as a solution:
Function GetSourceCode(url)
Set objHttp = CreateObject("Microsoft.XMLHTTP")
bGetAsAsync = False
objHttp.open "GET", url, bGetAsAsync
objHttp.send
If objHttp.status <> 200 Then
wscript.Echo "unexpected status = " & objHttp.status & vbCrLf & objHttp.statusText
wscript.Quit
End If
'MsgBox objHttp.responseText
GetSourceCode = objHttp.responseText
End Function
but that does not work. I've seen elsewhere that this is possible with AutoIT, but I cannot use AutoIT per security policy.
Any ideas?
Change Microsoft.XMLHTTP to Msxml2.ServerXMLHTTP
Function GetSourceCode(url)
Set objHttp = CreateObject("Msxml2.ServerXMLHTTP")
bGetAsAsync = False
objHttp.open "GET", url, bGetAsAsync
objHttp.send
If objHttp.status <> 200 Then
wscript.Echo "unexpected status = " & objHttp.status & vbCrLf & objHttp.statusText
wscript.Quit
End If
'MsgBox objHttp.responseText
GetSourceCode = objHttp.responseText
End Function
WScript.Echo GetSourceCode("https://anothervps.com/api/phpver")
having a similar problem to this post:
Previous older post here
I'm trying to download a file from a webserver that works great on my internal and external network but not when i try to download from a secure https:// server.
I get the following error Error picture here
I Have tried copying info from above problem but i'm not getting it right. can you please assist?
It works great internally and externally if not trying to access https!
Dim strURL, strFile, strFolder, oFSO, dt, oHTTP, oStream
strURL = "https://xx.xx.xx.xx/DataLogs/xxx.csv" 'external secure site
'strURL = "http://192.168.1.10/DataLogs/PLCData.csv" 'internal test
FileName="xxx.csv"
'FileName="PLCData.csv"
strFile = "xxx.csv" ''# The file name
'strFile = "PLCData.csv" ''# The file name
strFolder = "C:\PLC Data" '# The folder where to save the files
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
''# If the download folder doesn't exist, create it
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(strFolder) Then
oFSO.CreateFolder strFolder
End If
Set dt = CreateObject("WbemScripting.SWbemDateTime")
dt.SetVarDate Now
strFile = oFSO.GetBaseName(strFile) & "-" & Split(dt.Value, ".")(0) & "." & oFSO.GetExtensionName(strFile)
''# Download the URL
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP") 'replace with? Set oHTTP = CreateObject("MSXML2.XMLHTTP") MSXML2.ServerXMLHTTP
oHTTP.open "GET", strURL, False
oHTTP.send
If oHTTP.Status <> 200 Then
''# Failed to download the file
WScript.Echo "Error " & oHTTP.Status & ": " & oHTTP.StatusText
Else
Set oStream = CreateObject("ADODB.Stream")
oStream.Type = adTypeBinary
oStream.Open
''# Write the downloaded byte stream to the target file
oStream.Write oHTTP.ResponseBody
oStream.SaveToFile oFSO.BuildPath(strFolder, strFile), adSaveCreateOverWrite
oStream.Close
End If
I try to POST some data to a PHP script with VBScript, but something I do wrong...
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open()
objStream.LoadFromFile("base64.txt")
objDocElem.nodeTypedValue = objStream.Read()
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.open "POST", "http://mysite.com/data.php", False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send "data=" + objDocElem.text
'MsgBox objHTTP.responseText
Set objHTTP = Nothing
Set objStream = Nothing
C:\Documents and Settings\User\Desktop\data\test.vbe(3, 1)
ADODB.Stream : Arguments are of the wrong type, are out of acceptable
range, or are in confli ct with one another.
Solved it myself.
Dim TextArea
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set TextFile = oFSO.OpenTextFile("base64.txt", 1)
TextArea = ""
Do Until TextFile.AtEndOfStream
TextArea = TextArea & TextFile.ReadLine & vbNewLine
Loop
TextFile.Close
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.open "POST", "http://mysite.com/data.php", False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send "data=" + TextArea
Set oFSO = Nothing
Set TextFile = Nothing
Set objHTTP = Nothing
I'm writing a vbscript to pull some data from a webpage, strip out a few key pieces of information and write those to a file.
At the moment my script to access the pages and save the file contents to a string is this:
Set WshShell = WScript.CreateObject("WScript.Shell")
Set http = CreateObject("Microsoft.XmlHttp")
'Load Webpage where address is URL
http.open "GET", URL, FALSE
http.send ""
'Assign webpage contents as a string to variable called Webpage
WEBPAGE = http.responseText
I need to save the content to a string so I can use a regular expression on it to pull out the content that I need.
This script works perfectly, EXCEPT for when the pages contain non-standard characters (such as é). When the page contains something like this, the script throws up an error and stops.
I'm guessing this is something to do with the encoding, but I can't work out how to fix it. Can anyone point me in the right direction? Thanks guys
Edit
Thanks to the help here I realised I've asked the wrong question! It turns out I was downloading the content fine - the problem was, afterwards I was trying to edit it and write it out to a file, and the file was in the wrong format. I had this:
Set objTextFile = objFSO.OpenTextFile(OutputFile, 8, True,)
Changing it to this:
Set objTextFile = objFSO.OpenTextFile(OutputFile, 8, True, -1)
Seems to have fixed it. What a crazy world, eh? Thanks for the help.
You may need to set the correct header blocks before send
eg the following is an example only. You will need to find out what this is exactly for your website
http.open "GET", URL, FALSE
http.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
http.SetRequestHeader "Accept", "text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"
http.SetRequestHeader "Accept-Language", "en-us,en;q=0.5"
http.SetRequestHeader "Accept-Charset", "ISO-8859-1,utf-8;q=0.7,*;q=0.7"
http.send ""
EDIT:
What about this instead. It works ok here
Dim XMLHttpReq,URL,WEBPAGE
Const Eacute = "%C3%89"
Set XMLHttpReq = CreateObject("MSXML2.ServerXMLHTTP")
URL = "http://en.wikipedia.org/wiki/%C3%89"
'Load Webpage where address is URL
XMLHttpReq.Open "GET", URL, False
XMLHttpReq.send ""
'Assign webpage contents as a string to variable called Webpage
WEBPAGE = XMLHttpReq.responseText
WEBPAGE = Replace(WEBPAGE, Eacute, "É")
'Debug.Print WEBPAGE
The E acute in this case returns as string %C3%89 and you can force it to whatever character you choose if required.
EDIT2:
Just to add, if you're doing this with VBScript you may find this method useful
Dim XMLHttpReq, URL, WEBPAGE, fso, f
Const Eacute = "%C3%89"
Set XMLHttpReq = CreateObject("MSXML2.ServerXMLHTTP")
URL = "http://en.wikipedia.org/wiki/%C3%89"
XMLHttpReq.Open "GET", URL, False
XMLHttpReq.send ""
WEBPAGE = XMLHttpReq.responseText
Save2File WEBPAGE, "C:\Users\osknows\Desktop\test.txt"
Sub Save2File (sText, sFile)
Dim oStream
Set oStream = CreateObject("ADODB.Stream")
With oStream
.Open
.CharSet = "utf-8"
.WriteText sText
.SaveToFile sFile, 2
End With
Set oStream = Nothing
End Sub