ADODB Stream convert binary to string - excel

I'm facing a problem when trying to open a file from a URL using ADODB, and then using that as a string stream. Basically, the issue I'm facing is almost a duplicate of this question here:
convert ADODB binary stream to string vba
Except that I have to use an ADODB Stream to work with the content later on. Therefore, skipping ADODB completely is not an option, like in the answer in the other topic.
Right now, what I'm doing is making a HTTP GET Request, using a binary stream to save it as a file, then loading that very same file using a text stream. This works just fine, but there has to be a way to skip the saving-loading part and make it work directly.
Here is the code I have so far:
Dim myURL As String
myURL = "https://xyz.xyz/xyz.csv"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send
Dim objStream, strData
Dim leftcellstarttemp As Variant, rightcellstarttemp As Variant, leftcellendtemp As Variant, rightcellendtemp As Variant, r As Long, line As String, dtStr As String, mlValue As String, dtArr() As String
myURL = WinHttpReq.ResponseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile "C:\Temp\file1.csv", 2
oStream.Close
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Type = 2
objStream.Open
objStream.LoadFromFile "C:\Temp\file1.csv"
line = objStream.ReadText(-2)
End If
Do Until objStream.EOS
(and so on, and so forth...)
Can you help me on how I can get past this needless file saving-loading process?
Thanks!

Related

How can I parse values from a dynamic webpage using Excel VBA when XML/XPath doesn't seem to work?

I am attempting to scrape values from a collection of webpages using an XPath to parse what I want out of the XML. I grab the full XPath from the element using Chrome but then when I use in the code it doesnt seem to select the node I am looking for. Also when I execute the XPath statement in the console it also does not return the node. Some other element XPaths work in console but not in VBA. Am I missing something? My simple test XML works ok. My attempts to use namespace in the XPath were also not successful. Code below with an example of one of the webpages and one of the elements of interest:
Sub test()
testXML = "<test example='hello'>hello</test>"
Dim oXMLHTTP As Object
Dim sPageHTML As String
Dim sURL As String
Dim XmlResponse As String
Dim strXML As String
Dim xNode As MSXML2.IXMLDOMNode
Dim xmlElement As MSXML2.IXMLDOMElement
Dim XDoc As MSXML2.DOMDocument60
sURL = "https://www.bestplaces.net/crime/zip-code/alaska/anchorage/99510"
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.SetOption(2) = 13056 'Disable CA messages
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.send
XmlResponse = oXMLHTTP.responseText
'strXML = testXML
strXML = XmlResponse
Set XDoc = New MSXML2.DOMDocument60
'XDoc.setProperty "SelectionNamespaces", "xmlns:a='http://www.w3.org/1999/xhtml'"
'XDoc.setProperty "SelectionNamespaces", "xmlns:a='http://www.w3.org/2000/svg'"
'XDoc.setProperty "SelectionNamespaces", "xmlns:a='http://www.w3.org/1999/xlink'"
XDoc.LoadXML (strXML)
'Set xNode = XDoc.SelectSingleNode("/test")
Set xNode = XDoc.SelectSingleNode("/html/body/form/div[7]/div[2]/div[2]/div[3]/div/div/div/div/div/svg/g[6]/g[1]/text/tspan[2]")
If xNode Is Nothing Then
MsgBox "Nothing"
Else: MsgBox xNode.text
End If
End Sub
You are getting html back. A quick look at the page source shows that value is populated dynamically, but should be available by regex out of responseText; so your xpath wouldn't work even if converted to equivalent path for html parser.
Option Explicit
Public Sub GetValue()
Dim http As Object, s As String, re As Object
Set http = CreateObject("MSXML2.XMLHTTP")
Set re = CreateObject("VBScript.RegExp")
With http
.Open "GET", "https://www.bestplaces.net/crime/zip-code/alaska/anchorage/99510", False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
s = .responseText
End With
With re
.Pattern = "data:\s?\[(.*?),"
Debug.Print .Execute(s)(0).SubMatches(0)
End With
End Sub
Regex explanation:

Download zipped csv file after extracting it

I have the url which contains a zipped csv file, I need to download only .csv from the zip , the Codes below is downloading zip
Sub DownloadFile()
Dim myURL As String
myURL = "https://www1.nseindia.com/content/historical/EQUITIES/2020/FEB/cm07FEB2020bhav.csv.zip"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile "C:\Users\playt\Desktop\STACK\ruff.zip", 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub
You cannot download a file from an archive, but you can adapt your code in the next way:
Insert this lines at the end of your existing code (just before End Sub):
Dim zipFileName As String, unZipFolderName As String
zipFileName = "C:\Users\playt\Desktop\STACK\ruff.zip"
unZipFolderName = left(zipFileName, InStrRev(zipFileName, "\") - 1)
UN_Zip zipFileName, unZipFolderName
The simplest sub able to unzip and delete the archive must look like that (it needs a reference to 'Microsoft Shell Controls And Automation'):
Private Sub UN_Zip(zipFileName As String, unZipFolderName As String)
Dim wShApp As New Shell
wShApp.Namespace(unZipFolderName).CopyHere wShApp.Namespace(zipFileName).Items
Kill zipFileName
End Sub
If too lazy for adding the reference, to make the code look more elegant, the sub can be adapted with only two lines:
Use Dim wShApp As Object instead of Dim wShApp As New Shell declaration and then add the next line:
Set ShApp = CreateObject("Shell.Application")
In this way, no reference is necessary, anymore...

Extract from a Dropbox account with Excel VBA

I am attempting to pull data from a Dropbox account with Excel VBA.
I removed the URL to make the generic script easier to follow:
Sub DownloadFile()
Dim myURL As String
myURL = "Some URL HEre"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send
myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile "C:\Users\Eric\Downloads\Miami.txt", 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub
My original URL is the Dropbox URL, which includes the text file in the sub directories (..../..../somefile.txt). I do not know what to do for the username and password options, and left those untouched when I originally ran the file.
When I did run the code, I had success, however I had a mass amount of HTML code pulled and not the text file downloaded.

Issues when requesting FTP file with VBA

I am trying to make a part in my routine which retrieves a .xls document from a FTP location.
I have been googling for quite a few hours now and I am starting to get quite frustrated with this piece of code.
When running the code I get Run-Time error '3001' saying that my arguments are either of the wrong type and are out of the aceptable range, or are in conflict with one another.
Sub GetFTPFile()
Dim objXML
Dim strFTPResponse
Dim varUser, varPassword As Variant
Dim LocalDir As String
Set objXML = CreateObject("MSXML2.XMLHTTP")
strURL = "ftp://xyz_hourly.xls"
LocalDir = "c//"
varUser = "xxx"
varPassword = "yyy"
Call objXML.Open("GET", strURL, varUser, varPassword, False)
Call objXML.send
Do While objXML.readystate <> 4
DoEvents
Loop
Set File = CreateObject("ADODB.Stream")
File.Type = 1
File.Open
File.Write objXML.ResponseBody
File.SaveToFile "c//yyy.xlsx", 2
End Sub

Changing Contents of Select tag on a webpage using excel vba (To download CSV files from the webpage)

I am trying to download all the csv files from a specific website by using excel vba
Following is the code i have prepared :
Sub Gettable()
Dim URL As String
Dim ie As Object
Dim ieDoc As Object
Dim sel_day As Variant
URL = "http://www.bseindia.com/markets/equity/EQReports/BhavCopyDebt.aspx?expandable=3"
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate URL
Do Until (ie.readyState = 4 And Not ie.Busy)
DoEvents
Loop
Set ieDoc = ie.document
'============================================================================
ieDoc.getElementsByTagName("Select")("fdate1").Options("02").SelectIndex
'============================================================================
'ie.Quit
'Set ie = Nothing
'Set ieDoc = Nothing
End Sub
Now the problem i am facing here is i am not able to change the contents dropdown box(to form a date).
I have already tried lots of solutions from stackoverflow as well as other websites but havent got any success. i have good programming knowledge but am stuck at this point the whole day. Any help would be appreciated. thanks in advance :)
All i wanted in the end was to download all csv files. I figured out an alternative solution in the mean time to download the csv file but would still appreciate if someone gives a solution to this issue i had posted above... :)
My alternative Solution as follows :
Sub try10() 'Took me 10 tries by the way :)
Dim NoOfDays As Long, i As Long
Dim MyDate As Variant
'Since the minimum date can't be less #1/1/2007# so lets loop until Mydate reaches #1/1/2007#.
NoOfDays = Date - #1/1/2007#
For i = 0 To NoOfDays
MyDate = Format((Date - i), "ddmmyy")
Dim myURL As String
myURL = "http://www.bseindia.com/download/BhavCopy/Equity/eq" & MyDate & "_csv.zip"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send
myURL = WinHttpReq.ResponseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile ("C:\Users\X\Desktop\BhavCopies\eq" & MyDate & "_csv.zip")
oStream.Close
End If
Next
End Sub
This solution however produces a 211kb fake file for csv's that don't exist which can be dealt with manually . :) ;)
The items you are trying to control are in an iframe. To get to the HTML inside the iframe, extract the src attribute from the tag and navigate to the URL formed by that src and the base URL. In this case the src is "Equitydebcopy.aspx", so if you navigate to "http://www.bseindia.com/markets/equity/EQReports/Equitydebcopy.aspx" you'll find that the following lines will allow you to get the information you want.
ie.document.getElementByID("fdate1").Value = "15"
ie.document.getElementByID("fmonth1").Value = "1"
ie.document.getElementByID("fyear1").Value = "2014"
ie.document.getElementByID("btnSubmit").Click

Resources