Read html line by line in VBScript - html

I have a script that will pull the html down and put it into a text or HTML file. I can then parse the text file line by line, but I'd rather either parse the website itself or parse the textstream as I get it. Is this possible using VBS (my scripting languages are limited)?
Code:
dim URL
url = "www.something.com"
set wshshell = wscript.createobject("wscript.shell")
set http = createObject("microsoft.xmlhttp")
on error resume next
http.open "GET", URL, FALSE
http.send
if err.number = 0 then
outputFile.writeline http.responsetext
else
wscript.echo "error " & err.number & ": " & err.description
end if
set wshshell = nothing
set http = nothing
patchStatusFile.close
It works fine if I write to an external HTML file. I was wondering if I HAD to write to a file or can I parse the stream first? ie:
strToLookAt = http.responsetext
do until strToLookAt.atEndOfStream
strLine = strToLookAt.readLine
if strLine = "the thing I'm looking for"
...do stuff...
end if
loop

Why did no one answer such a simple question?
here is an example of what I do.
dim up_http : up_http = "http://www.metrolyrics.com/Cornography-lyrics-Brad-Paisley.html"
dim xmlhttp : set xmlhttp = createobject("MSXML2.XMLHTTP.6.0")
xmlhttp.open "get", up_http, True
xmlhttp.send
LyricsURL = xmlhttp.responseText
'At this point we have the html from the web page in memory variable LyricsURL
No need to write to any file.
You can just process the memory variable line for line.
In this case (script not shown) I have it in a function (get_html). I then process each line of the result of the function looking for a particular strings that mark the beginning and end of the Lyrics. Then I save that result into a variable then I replace and delete characters in this variable.

Never got an answer. What I decided to do was:
1) Create a temp file where I store the text info.
2) Parse temp file.
3) Delete Temp file.
Not best idea, but in all honesty, this isn't the best script anyway. Just realized there was an "export" button on the SCCM report. I am going to see about utilizing that in a script.

Related

How do you import json data from a url utilizing VBA?

I have the following json array which you can easily access at the below url:
https://crowdfluttr.firebaseio.com/test/array.json
It has the following output:
{"-0p":{"date":"2015-01-01","string":"apple","value":1},"-1p":{"date":"2015-02-04","string":"banana","value":50},"-2p":{"date":"2015-02-03","string":"carrot","value":99},"-3p":{"date":"2015-02-02","string":"banana","value":20},"-4p":{"date":"2015-03-01","string":"banana","value":11},"-5p":{"date":"2015-04-01","string":"kiwi","value":23},"-6p":{"date":"2015-05-01","strawberry":"banana","value":10}}
I'd like to pull this json data from this url and then parse it to push into microsoft access.
I found resources explaining how to parse JSON (Parsing JSON, Parsing JSON in Excel VBA) but not pull it from a URL and then parseit
I would use XMLHTTP to download the JSON.
For parsing JSON with VBA see https://github.com/VBA-tools/VBA-JSON.
Download the ZIP file. Extract the JsonConverter.bas. Open Excel and the VBA-editor with your VBA-project. Right click the VBA-project in Project Explorer and click Import File.... Browse to the JsonConverter.bas file and import it. Make sure, you have included a reference to "Microsoft Scripting Runtime" via Tools-References.
Example using your URL:
Sub test()
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
sURL = "https://crowdfluttr.firebaseio.com/test/array.json"
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
sGetResult = httpObject.responseText
MsgBox sGetResult
Dim oJSON As Object
Set oJSON = JsonConverter.ParseJson(sGetResult)
For Each sItem In oJSON
dItemDate = oJSON(sItem)("date")
sItemString = oJSON(sItem)("string")
vItemValue = oJSON(sItem)("value")
MsgBox "Item: " & sItem & " Date: " & dItemDate & " String: " & sItemString & " Value: " & vItemValue
Next
End Sub
This code will work for your sample JSON like:
{"-0p":{"date":"2015-01-01","string":"apple","value":1},"-1p":{"date":"2015-02-04","string":"banana","value":50}, ... }
You will have to analyze the JSON you get from httpObject.responseText to adapt the code for getting values from other JSON structures.
Just in case someone stumbled on this same question but needs to send parameters first before getting the responseText, you will need to tweak Axel's answer a bit.
httpObject.Open "POST", sURL, False '// instead of GET, use POST //
httpObject.SetRequestHeader "Content-Type", "Application/json" '// specify header //
httpObject.Send "{""param1"":""value1"",""param2"":""value2""}" '// pass parameter //
sGetResult = httpObject.responseText '// get response //
The next step is the same parsing of result using the functions provided above.
You can study the answer here and then look up VBA.CVRAPI which contains all necessary Json modules to retrieve data from a URL. Though created for another purpose, the Json modules are generic and can easily be reused.
The demo form included demonstrates this. You should be able to adopt it to your URL for a test.

Downloading a file with WINHTTP using POST/GET and headers (with VBA)

As a follow up to my previous question: Automating File Download of a link that looks like this: https://www.domain.com/TableData/TableA.csv
I am learning more about headers that are sent with POST and GET - but I am far from knowing what I need to know.
The code I have so far works in downloading the file, but the problem from the last question is still persisting. When I open the downloaded file after execution it is filled with html of the login page as though the credentials did not work from the POST login. I suspect my problem lies in the strAuthenticate string, but I don't know for sure.
Sub SaveFileFromURL()
Dim FileNum As Long
Dim FileData() As Byte
Dim WHTTP As Object
fileUrl = "https://www.ncci.com/Manuals/RateTableData/State/XX/XX.csv"
filePath = "C:\Apps\information.csv"
myuser = "xxxxxx"
mypass = "xxxxxx"
strAuthenticate = "sm_userid=xxxxx&sm_password=xxxxxx"
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
WHTTP.Open "POST", "https://www.ncci.com", False
WHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WHTTP.send strAuthenticate
x = WHTTP.getResponseHeader("Set-Cookie")
MsgBox x
WHTTP.Open "GET", fileUrl, False
WHTTP.setRequestHeader "Cookie", x
WHTTP.send
FileData = WHTTP.responseBody
Set WHTTP = Nothing
FileNum = FreeFile
Open filePath For Binary Access Write As #FileNum
Put #FileNum, 1, FileData
Close #FileNum
MsgBox "File has been saved!", vbInformation, "Success"
End Sub
BIG THANK YOU TO RYAN WILDRY! Problem Solved.
I needed to set two specific cookies and change the actual login link - using the main domain was not working.
For anyone else who finds this post one day - Look through the cookies using the developer tools and find the ones that you need to pass on login. I personally tested them by having a message box with the response headers pop up which I compared to the response headers that I usually get when I login manually.

Visual Basic downloads json instead of reading it

I am making a request to a webpage using Visual Basic and i want to parse the response and add it to a database. My problem is that when i make the request, Windows prompts a question that asks if i want to save the file. Is there a way to receive the response as string directly in VB?
Here is a sample of my code:
Dim ret As Long
Dim ie As Object
'checking connection state
ret = InternetGetConnectedStateEx(ret, sConnType, 254, 0)
'instantiating IE
Set ie = CreateObject("internetexplorer.application")
'hiding browser
ie.Visible = False
'opening link
Header = "x-api-key:..." & Chr(10) & Chr(13)
ie.Navigate "https://api.openapi.ro/api/companies/13548146", , , , Header
If this is VBA, I suggest using XMLHTTP. In the VBA IDE, use tools--->references to add a reference to "Microsoft XML, v6.0" in the project (you may have a different version, adjust your code and references accordingly).
Here is an example of how you might use it:
Public Sub TestIt()
Dim xh As XMLHTTP60
Set xh = New XMLHTTP60
With xh
.Open "GET", "https://jsonplaceholder.typicode.com/posts/1"
.send
End With
'In this case, the response text was in ASCII, so I had to use StrConv to convert it to Unicode for VBA.
Debug.Print StrConv(xh.responseBody, vbUnicode)
End Sub

WScript / vbscript check if file in directory

IN THE BOTTOM CODE THAT WORKED
Working on a variation of Convert XLS to CSV on command line that I could use to copy xls as csv.
I just want to copy files that are not yet copied, so need to check if file already exists in my target directory.
Was thinking something like:
Set fso=CreateObject("Scripting.FileSystemObject")
Set sourcefldr=fso.getFolder(sourcepath)
Set targetfldr=fso.getFolder(targetpath)
for each sfile in sourcefldr.files
for each tfile in target
if not file in targetfldr.files then
'create excelfile and save as csv
however file in targetfldr.files not working
How can I avoid looping over all my target files every time?
tks in advance!
EDIT:
Incorporated #Pankaj Jaju and #Ansgar Wiechers answer and below is working!
csv_format = 6
sourcestring ="C:\sourcefolder"
deststring= "V:\destfolder"
Set fso=CreateObject("Scripting.FileSystemObject")
Set sourcefldr=fso.getFolder(sourcestring)
Set destfldr=fso.getFolder(deststring)
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
for each sfile in sourcefldr.files
destname = left(sfile.name,len(sfile.name)-3) & "csv"
fulldest = fso.buildpath(destfldr, destname)
if not fso.FileExists(fulldest) then
Set oBook = oExcel.Workbooks.Open(sfile)
oBook.SaveAs fulldest, csv_format
oBook.Close False
WScript.Echo "Copied " & fulldest
end if
next
oExcel.Quit
Try this !
set fso=createobject("scripting.filesystemobject")
set sourcefldr=fso.getfolder(sourcepath).files
for each sfile in sourcefldr
if not fso.fileexists(fso.buildpath(targetpath, sfile.name)) then
fso.getfile(sfile).copy(fso.buildpath(targetpath, sfile.name))
end if
next
Best bet would be add all of your target folder files into a dictionary. This way you can just use "Exists" to search for it in the dictionary.
Set fso=CreateObject("Scripting.FileSystemObject")
Set filesDic = CreateObject("Scripting.Dictionary")
Set targetfldr=fso.getFolder(targetpath)
'add destination files into dictionary
For Each file in targetfldr.files
filesDic.Add file.name, file.name
Next
This way all you need to do is check the new filename against the dictionary
filesDic.Exists(file.name)
This will just return a true / false
Here is a bit more information about the dictionary http://www.devguru.com/technologies/vbscript/13992

Creating 2D (Data Matrix or QR Codes) in MS Access Reports/Forms

We are in the process of implementing code to read/create 2D bar codes that are starting to show up on our supplier's parts.
We have a need to create the 2D bar codes in MS Access reports and forms. Has anyone had success with the font (IDAutomation) or Active X (dlSoft) solutions out there.
For C#, the open source library "http://barcoderender.codeplex.com/" was suggested. Any thoughts on how successful this was or if anyone has other open-source and/or pay for options.
Thanks,
Anton
Depending on the volume of codes you need to generate, you could use the Google Charts API to generate QR Codes.
Simply add a "Microsoft Web Browser" ActiveX component and the following code to your Form:
Dim Size As Integer
Dim Text As String
Dim URL As String
Size = 200
Text = "This is my test"
' Better to actually use a URL encoding function like those described here:
' http://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba
Text = Replace(Text, " ", "%20")
URL = "http://chart.apis.google.com/chart?chs=" & Size & "x" & Size & "&cht=qr&chld=H|0&chl=" & Text
WebBrowser.Navigate (URL)
You can of course change the Size and the Text depending on your need. The Text can also be a value directly from your Form, therefore your data.
I would advise you to check Googles Terms and Services before using it.
I completely escaped the web browser control and the Google API since that functionality is now deprecated from what I can tell. I went with a different free API but the Google API or any other API could be used instead.
In my example I am creating an .png image in the same directory as the application. I have a text box on my form named txtToCode in which I type in any text I want to code. I also have an image control so that the image can be viewed from the form, but you can modify it how you wish:
Private Sub btnCode2_Click()
Call GetQRCode(Me.txtToCode, 150, 150)
End Sub
Sub GetQRCode(Content As String, Width As Integer, Height As Integer)
Dim ByteData() As Byte
Dim XmlHttp As Object
Dim HttpReq As String
Dim ReturnContent As String
Dim EncContent As String
Dim QRImage As String
EncContent = EncodeURL(Content)
HttpReq = "https://api.qrserver.com/v1/create-qr-code/?data=" & EncContent & "&size=" & Width & "x" & Height & ""
Set XmlHttp = CreateObject("MSXML2.XmlHttp")
XmlHttp.Open "GET", HttpReq, False
XmlHttp.Send
ByteData = XmlHttp.responseBody
Set XmlHttp = Nothing
ReturnContent = StrConv(ByteData, vbUnicode)
Call ExportImage(ReturnContent)
End Sub
Private Sub ExportImage(image As String)
Dim FilePath As String
On Error GoTo NoSave
' Build Export Path
FilePath = Application.CurrentProject.Path & "\qr.png"
Open FilePath For Binary As #1
Put #1, 1, image
Close #1
Me.Image3.Picture = FilePath
' Save File Path
Exit Sub
NoSave:
MsgBox "Could not save the QR Code Image! Reason: " & Err.Description, vbCritical, "File Save Error"
End Sub
Private Function EncodeURL(str As String)
Dim ScriptEngine As Object
Dim encoded As String
Dim Temp As String
Temp = Replace(str, " ", "%20")
Temp = Replace(Temp, "#", "%23")
EncodeURL = Temp
End Function