I have JSON file and this is a preview of its structure
Is there a way to cut off the 'allTests' part and export it to new JSON file?
Try the following. Special characters are preserved. Hopefully the relevant JSON is cut out.
Option Explicit
Public Sub GetJSONExtract()
Dim fso As Object, jsonFile As Object, jsonText As String, arr() As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set jsonFile = fso.OpenTextFile("C:\Users\User\Desktop\Sample.json")
jsonText = jsonFile.ReadAll
arr = Split(jsonText, Chr$(34) & "allTests" & Chr$(34))
jsonText = Replace$(arr(2), ":", vbNullString, 1, 1)
jsonText = Split(jsonText, Chr$(34) & "time" & Chr$(34))(0)
jsonText = Left$(jsonText, InStrRev(jsonText, ",") - 1)
With fso.CreateTextFile("C:\Users\User\Desktop\Test.json")
.write jsonText
End With
End Sub
Using: https://github.com/VBA-tools/VBA-JSON
Sub ParseItOut()
Const f_PATH As String = "C:\Users\Tim\Desktop\"
Dim fso, j, obj, subObj
Set fso = CreateObject("scripting.filesystemobject")
j = fso.OpenTextFile(f_PATH & "sample.json").ReadAll()
Set obj = JsonConverter.ParseJson(j)
'get the required section
Set subObj = obj("results")(1)("allTests")
'write to file as JSON
fso.CreateTextFile(f_PATH & "sample_mod.json").Write JsonConverter.ConvertToJson(subObj)
End Sub
EDIT: this seems to be a problem -
Under allTests each item is an object with a single property/key (which is very large and contains embedded quotes escaped by \) and a value of true
The library I used seems to have an issue with that (or I don't know how to use it correctly...)
Related
I want to retrieve a table from the URL of https://s.cafef.vn/screener.aspx#data using VBA. This task is difficult because the table contains JSON data embedded in an html file.
Taking #Tomalak ‘s advice, I am trying to split up my task; solving four following individual problems one after another:
Send an HTTP request to have the HTML
Locate the JSON string
Parse JSON with VBA and then
Loop over the raw data from the JSON and write into an Excel table.
Extract a JSON DATA table in html using VBA; converting Apps Script into VBA
However, I get stuck at Step 2, the response text that I get is stored in htmlTEXT. Its print-out looks like below attached, but the problem is as a string variable, htmlTEXT can hold up only a small part of the html page content. The JSON paragraph does not lie on the top part of the html page and is therefore not returned into htmlTEXT.
My questions are:
How can we get the whole content of the html page (with the JSON paragraph included)?
Once the JSON paragraph is captured, what Regular Expression can be used to extract the JSON paragraph ?
Noticing that the JSON paragraph starts with [{ and ends with }], I therefore use the pattern [{*}] but it does not work at all, (though it works with pattern like (D.C); resulting in DOC for my testing purpose)
What is wrong with my code?
Sub ExtractJSON_in_html()
' =====send an HTTP request with VBA ====
Dim JSONtext As String
Dim htmlTEXT As String
Dim SDI As Object
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
Url = "https://s.cafef.vn/screener.aspx#data"
objHTTP.Open "GET", Url, False
objHTTP.send
htmlTEXT = objHTTP.responsetext
MsgBox htmlTEXT
' ===== Locate the JSON string =======
Set SDI = CreateObject("VBScript.RegExp")
SDI.IgnoreCase = True
SDI.Pattern = "[{*}]"
SDI.Global = True
Set theMatches = SDI.Execute(htmlTEXT)
For Each Match In theMatches
'MsgBox Match.Value
JSONtext = Match.Value
Next
End Sub
htmlTEXT:
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"/>
-- JASON Paragraph var jsonData = [{"Url":"http://s.cafef.vn/upcom/A32-cong-ty-co-phan-32.chn","CenterName":"UpCom","Symbol":"A32","TradeCenterID":9,"ChangePrice":0,"VonHoa":212.84,"ChangeVolume":400,"EPS":6.19220987764706,"PE":5.0547382305287,"Beta":0,"Price":0,"UpdatedDate":"\/Date(1625562652463)\/","FullName":"Công ty cổ phần 32","ParentCategoryId":0
{"Url":"http://s.cafef.vn/upcom/YTC-cong-ty-co-phan-xuat-nhap-khau-y-te-thanh-pho-ho-chi-minh.chn","CenterName":"UpCom","Symbol":"YTC","TradeCenterID":9,"ChangePrice":0,"VonHoa":170.8,"ChangeVolume":200,"EPS":-4.29038514857143,"PE":-14.217837766922,"Beta":0,"Price":0,"UpdatedDate":"\/Date(1625562969277)\/","FullName":"Công ty Cổ phần Xuất nhập khẩu Y tế Thành phố Hồ Chí Minh","ParentCategoryId":0}];
This will return the JSON string as a Dictionary object for you to work through:
You will need JsonConverter (and reference to Microsoft Scripting Runtime for Dictionary object)
Private Sub Test()
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
xmlhttp.Open "GET", "https://s.cafef.vn/screener.aspx"
xmlhttp.send
Dim jsonStr As String
jsonStr = Mid$(xmlhttp.responseText, InStr(xmlhttp.responseText, "[{"))
jsonStr = Left$(jsonStr, InStr(jsonStr, "}]") + 1)
Dim jsDict As Scripting.Dictionary
Set jsDict = JsonConverter.ParseJson("{""results"":" & jsonStr & "}")
Debug.Print jsDict("results").Count '1874
End Sub
Note: The original URL in your question returns 404 error, you just need to remove #data from the URL.
I would want more certainty over matching the correct JavaScript object than given by the current Instr methods (which could be extended to include the var jsonData pattern as well.) In case of using regex then the following pattern can be used, which will allow for line break matching. Note, you only need one entire match then parse the JavaScript array returned with a json parser.
Public Sub ExtractJSON_in_html()
' =====send an HTTP request with VBA ====
Dim JSONtext As String
Dim htmlTEXT As String
Dim SDI As Object
Set OBJHTTP = CreateObject("MSXML2.XMLHTTP")
URL = "https://s.cafef.vn/screener.aspx"
OBJHTTP.Open "GET", URL, False
OBJHTTP.setRequestHeader "User-Agent", "Mozilla/5.0"
OBJHTTP.send
htmlTEXT = OBJHTTP.responseText
MsgBox htmlTEXT
' ===== Locate the JSON string =======
Set SDI = CreateObject("VBScript.RegExp")
SDI.IgnoreCase = True
SDI.Pattern = "var\sjsonData\s=\s([\s\S].*)?;"
WriteTxtFile SDI.Execute(htmlTEXT)(0).SubMatches(0)
End Sub
Public Sub WriteTxtFile(ByVal aString As String, Optional ByVal filePath As String = "C:\Users\<user>\Desktop\Test.txt")
Dim fso As Object, Fileout As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fileout = fso.CreateTextFile(filePath, True, True)
Fileout.Write aString
Fileout.Close
End Sub
Regex:
Sample of treeview of result:
Array with 1874 elements; 1 expanded.
Edited your macro.. This will add a worksheet and parse JSON text from Range A1
Option Explicit
Sub ExtractJSON_in_html()
Dim JSONtext As String, JSONtextarr() As String, Url As String
Dim htmlTEXT As String, colHead As String
Dim SDI As Object, objHTTP As Object, theMatches As Object, Match As Variant
Dim StartPos As Long, endPos As Long, i As Long
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
Url = "https://s.cafef.vn/screener.aspx"
' =====send an HTTP request with VBA ====
objHTTP.Open "GET", Url, False
objHTTP.send
htmlTEXT = objHTTP.responseText
StartPos = InStr(1, htmlTEXT, "var jsonData = [", vbTextCompare)
endPos = InStr(StartPos, htmlTEXT, "]", vbTextCompare)
htmlTEXT = Replace(Mid(htmlTEXT, StartPos, endPos - StartPos + 1), ",""", ";")
' ===== Make the JSON strings collecton =======
Set SDI = CreateObject("VBScript.RegExp")
SDI.IgnoreCase = True
SDI.Global = True
SDI.Pattern = "[^a-zA-Z0-9&{}./:;,-]"
htmlTEXT = SDI.Replace(htmlTEXT, "")
SDI.Pattern = "\{([^}]+)\}"
Set theMatches = SDI.Execute(htmlTEXT)
JSONtext = ""
Debug.Print theMatches.Count
For Each Match In theMatches
JSONtext = JSONtext & Match.Value & ","
Next
' ===== Populate new worksheet with parsed JSON =======
JSONtext = Replace(Mid(JSONtext, 2, Len(JSONtext) - 3), ",ParentCategoryId", ",,ParentCategoryId", , , vbTextCompare)
JSONtextarr = Split(JSONtext, "},{", , vbTextCompare)
Worksheets.Add
Range("A2").Resize(UBound(JSONtextarr) + 1, 1).Value = Application.Transpose(JSONtextarr)
Range("A2").CurrentRegion.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, TrailingMinusNumbers:=True
Debug.Print Range("A2").CurrentRegion.Columns.Count
For i = 1 To Range("A2").CurrentRegion.Columns.Count
colHead = Split(Cells(2, i), ":")(0)
Cells(1, i) = colHead
Range("A2").CurrentRegion.Columns(i).Replace What:=colHead & ":", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next i
End Sub
I’ve run into an issue retrieving values from a non-itemized JSON object. I thought it was simple do so … Just reference the object with the field you want (e.g. JSON(“title”). But I cannot retrieve a value even though it IS there.
This code demonstrates what I’m talking about. (Be sure to put a breakpoint on the “next” line, or it will run for a while.) The strID and strTitle values are not assigned and do not print out. But if you go to the immediate window and type
? JSON2("ID")
? JOON2(“title”)
You get the values. What am I doing wrong? Why can’t I get these values into variables?
Sub testMovie2()
Dim Url As String, data As String, data2 As String
Dim xml As Object, JSON As Object, JSON2 As Object, colObj As Object, colobj2 As Object, item, item2
Dim strID As String, strTitle As String
Url = "https://www.tiff.net/data/films-events-2018.json"
data = getHTTP(Url)
Set JSON = JsonConverter.ParseJson(data)
Set colObj = JSON("items")
For Each item In colObj
Url = "https://www.tiff.net/data/films/" & item("id") & ".JSON"
data2 = getHTTP(Url)
Set JSON2 = JsonConverter.ParseJson(data2)
strID = JSON2("ID")
Debug.Print strID
strTitle = JSON2("Title")
Debug.Print strTitle
Next
End Sub
JSON2 is a dictonary object and to retrieve element from dictonary use below
with key
JSON2.item("id")
JSON2.item("title")
OR
with index
JSON2.Items()(4)
JSON2.Items()(5)
By default dictionary objects are case sensitive
So JSON2("ID") not equals to JSON2("id")
To make it case insensitive use:
JSON2.CompareMode = vbTextCompare
Code:
Sub testMovie2()
Dim url As String, data As String, data2 As String
Dim xml As Object, JSON As Object, JSON2 As Object, colObj As Object, colobj2 As Object, item, item2
Dim strID As String, strTitle As String
url = "https://www.tiff.net/data/films-events-2018.json"
data = getHTTP(url)
Set JSON = JsonConverter.ParseJson(data)
Set colObj = JSON("items")
For Each item In colObj
url = "https://www.tiff.net/data/films/" & item("id") & ".JSON"
data2 = getHTTP(url)
Set JSON2 = JsonConverter.ParseJson(data2)
strID = JSON2.item("id")
Debug.Print strID
strTitle = JSON2.item("title")
Debug.Print strTitle
Next
End Sub
Function getHTTP(url) As String
Dim data As String
Dim xml As Object
Set xml = CreateObject("MSXML2.ServerXMLHTTP")
With xml
.Open "GET", url, False
.setRequestHeader "Content-Type", "text/json"
.send
data = .responseText
End With
getHTTP = data
End Function
I have the following JSON response:
{
"status": "Success",
"label": "pdf_base64_string",
"order": "ABC123456"
}
I'm trying to save a PDF file from the Base64 string per the following code:
FileData = Base64DecodeString(pdf_base64_string)
fileNum = FreeFile
FilePath = "C:\label.pdf"
Open FilePath For Binary Access Write As #fileNum
Put #fileNum, 1, FileData
Close #fileNum
This results in a broken/invalid PDF file (not recognized by the PDF viewer).
Adapted from: Inserting an Image into a sheet using Base64 in VBA?
This works for me - saves the file to the same location as the workbook running the code.
Sub TestDecodeToFile()
Dim strTempPath As String
Dim b64test As String
'little face logo
b64test = "R0lGODlhDwAPAKECAAAAzMzM/////wAAACwAAAAADwAPAAACIISPeQHsrZ5ModrLlN48" & _
"CXF8m2iQ3YmmKqVlRtW4MLwWACH+H09wdGltaXplZCBieSBVbGVhZCBTbWFydFNhdmVyIQAAOw=="
strTempPath = ThisWorkbook.Path & "\temp.png" 'use workbook path as temp path
'save byte array to temp file
Open strTempPath For Binary As #1
Put #1, 1, DecodeBase64(b64test)
Close #1
End Sub
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim objXML As Object 'MSXML2.DOMDocument
Dim objNode As Object 'MSXML2.IXMLDOMElement
'get dom document
Set objXML = CreateObject("MSXML2.DOMDocument")
'create node with type of base 64 and decode
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
'clean up
Set objNode = Nothing
Set objXML = Nothing
End Function
Points need to take care of for pdf to base64
If you are converting the pdf to base64/blob for rest API then do not use string variables because the size of a string variable is 32200 only.
If you are using pdf for rest API then you need to read the pdf in binary-only [ do not read it by text]
In VBA JSON file is sent through the text-only so try to use the streams instead of the JSON file.
I am sharing the code which does the binary conversion of base64 of the pdf file.
Function EncodeFileBase64(FileName As String) As String
fileNum = FreeFile
Open FileName For Binary As fileNum
ReDim arrData(LOF(fileNum) - 1)
Get fileNum, , arrData
Close fileNum
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeFileBase64 = objNode.text
EncodeFileBase64 = Replace(objNode.text, vbLf, "")
Set objNode = Nothing
Set objXML = Nothing
End Function
I have 6 text files in one folder.
I want combine selected files in to one text using access.
I have tried this code without success, because the one text file is created but is empty
Can any one help me on this?
Thanks in advance, my code below.
Lines in the text file:
xN;xDate;xNode;xCO;
100;2017-09-26 00:00:00;Valley;D6;
101;2017-09-25 00:00:00;Valley;D3;
...
...
Code:
Dim xPath
Function xExtract()
Dim xArray() As Variant
Dim I As Integer
Dim StrFileName As String
xPath = CurrentProject.Path
PDS:
xArray = Array("D1", "D2", "D3", "D4", "D5", "D6")
new_file = "" & xPath & "\PDS.txt"
fn = FreeFile
Open new_file For Output As fn
Close
For I = 0 To UBound(xArray)
StrFileName = "\\myserver\inetpub\ftproot\PDS_" & xArray(I) & ".txt"
fn = FreeFile
Open StrFileName For Input As fn
Open new_file For Append As fn + 1
Line Input #fn, dato
Do While Not EOF(fn)
Line Input #fn, dato
dati = Split(dato, Chr(9))
For d = 0 To UBound(dati)
If d = 0 Then
dato = Trim(dati(d))
Else
dato = dato & ";" & Trim(dati(d))
End If
Next
Print #fn + 1, dato
Loop
Close
Next I
Application.Quit
End Function
Here's code that works for concatenating comma delimited text files (probably would work for any text files). Pretty crude. Needs error handler and would benefit from common dialog to select output folder and file name. Also I don't like using non-typed variables, but I don't know what type of object some of them are and can't figure it out from Microsoft help. Warning, don't put output in same folder - might result in endless loop - trust me I tried it
Public Function CFiles(Filepath As String) As String
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Folder
Dim Filein As Object
Dim fileout As Object
Dim strText As String
Dim TheInputfile As Object
Dim filename As String
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(Filepath)
Set fileout = FSO.CreateTextFile("c:\InvestmentsPersonal\files\backup\output.txt", ForAppending, False)
For Each Filein In SourceFolder.Files
filename = Filein.Name
Set TheInputfile = FSO.OpenTextFile(Filepath & filename, ForReading)
strText = TheInputfile.ReadAll
TheInputfile.Close
fileout.WriteLine strText
Next
fileout.Close
Set fileout = Nothing
Set Filein = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
CFiles = "c:\InvestmentsPersonal\files\backup\output.txt"
End Function
As your code works for files with windows EOL format (CR (Carriage Return) + LF (Line Feed)), I guess your files are UNIX EOL format (just LF, no CR), check this with a texteditor like e.g. Notepad++ (View->Show Symbol->Show End of Line). This causesLine Inputto read the whole file in one line as it breaks on CR. Then you skip the first line and nothing is inserted, because all text is in this line.
You can useFileSystemObjectto avoid this as it breaks on LF.
Function xExtract()
Const ForReading = 1, ForWriting = 2, ForAppending = 8 'iomode constants
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'format constants
Dim xArray As Variant, dati As Variant
Dim i As Long, d As Long
Dim xPath As String, new_file As String, dato As String, StrFileName As String
Dim FSO As Object, TextStreamIn As Object, TextStreamOut As Object
xPath = CurrentProject.Path
new_file = xPath & "\PDS.txt"
xArray = Array("D1", "D2", "D3", "D4", "D5", "D6")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TextStreamOut = FSO.OpenTextFile(new_file, ForWriting, True, TristateUseDefault) 'open textstream to write
For i = 0 To UBound(xArray) 'loop through files
StrFileName = "\\myserver\inetpub\ftproot\PDS_" & xArray(i) & ".txt"
Set TextStreamIn = FSO.OpenTextFile(StrFileName, ForReading) ' open textstream to read
TextStreamIn.SkipLine 'skip first line with headers
Do Until TextStreamIn.AtEndOfStream 'loop through lines
dati = Split(TextStreamIn.Readline, Chr(9))
For d = 0 To UBound(dati)
If d = 0 Then
dato = Trim(dati(d))
Else
dato = dato & ";" & Trim(dati(d))
End If
Next
TextStreamOut.WriteLine dato 'write line to file
Loop
TextStreamIn.Close 'close textstream
Next i 'next file
TextStreamOut.Close
Set TextStreamOut = Nothing
Set TextStreamIn = Nothing
Set FSO = Nothing
Application.Quit
End Function
If you want to stay withOpen fileyou can split the first (and only) line on LF (Split(dato,vbLf) and ignore the first element, but you have to check the file is UNIX EOL format, FSO covers both.
This feels like it should be simple. I have a .HTML file stored on my computer, and I'd like to read the entire file into a string. When I try the super straightforward
Dim FileAsString as string
Open "C:\Myfile.HTML" for input as #1
Input #1, FileAsString
Close #1
debug.print FileAsString
I don't get the whole file. I only get the first few lines (I know the immediate window cuts off, but that's not the issue. I'm definitely not getting the whole file into my string.) I also tried using an alternative method using the file system object, and got similar results, only this time with lots of weird characters and question marks thrown in. This makes me think it's probably some kind of encoding issue. (Although frankly, I don't fully understand what that means. I know there are different encoding formats and that this can cause issues with string parsing, but that's about it.)
So more generally, here's what I'd really like to know: How can I use vba to open a file of any extension (that can be viewed in a text editor) and length (that's doesn't exceed VBA's string limit), and be sure that whatever characters I would see in a basic text editor are what gets read into a string? (If that can't be (easily) done, I'd certainly appreciate being pointed towards a method that's likely to work with .html files) Thanks so much for your help
EDIT:
Here's an example of what happens when I use the suggested method. Specifically
Dim oFSO As Object
Dim oFS As Object, sText As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFS = oFSO.OpenTextFile(Path)
Do Until oFS.AtEndOfStream
sText = oFS.ReadAll()
Loop
FileToString = sText
Set oFSO = Nothing
Set oFS = Nothing
End Function
I'll show you both the beginning (via a message box) and the end (via the immediate window) because both are weird in different ways. In both cases I'll compare it to a screen capture of the html source displayed in chrome:
Beginning:
End:
This is one method
Option Explicit
Sub test()
Dim oFSO As Object
Dim oFS As Object, sText As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFS = oFSO.OpenTextFile("C:\Users\osknows\Desktop\import-store.csv")
Do Until oFS.AtEndOfStream
' sText = oFS.ReadLine 'read line by line
sText = oFS.ReadAll()
Debug.Print sText
Loop
End Sub
EDIT:
Try changing the following line to one of the following 3 lines and see if it makes any difference
http://msdn.microsoft.com/en-us/library/aa265347(v=vs.60).aspx
Set FS = FSO.OpenTextFile("C:\Users\osknows\Desktop\import-store.csv", 1, 0)
Set FS = FSO.OpenTextFile("C:\Users\osknows\Desktop\import-store.csv", 1, 1)
Set FS = FSO.OpenTextFile("C:\Users\osknows\Desktop\import-store.csv", 1, 2)
EDIT2:
Does this code work for you?
Function ExecuteWebRequest(ByVal url As String) As String
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
oXHTTP.Open "GET", url, False
oXHTTP.send
ExecuteWebRequest = oXHTTP.responseText
Set oXHTTP = Nothing
End Function
Function OutputText(ByVal outputstring As String)
MyFile = ThisWorkbook.Path & "\temp.html"
'set and open file for output
fnum = FreeFile()
Open MyFile For Output As fnum
'use Print when you want the string without quotation marks
Print #fnum, outputstring
Close #fnum
End Function
Sub test()
Dim oFSO As Object
Dim oFS As Object, sText As String
Dim Uri As String, HTML As String
Uri = "http://www.forrent.com/results.php?search_type=citystate&page_type_id=city&seed=859049165&main_field=12345&ssradius=-1&min_price=%240&max_price=No+Limit&sbeds=99&sbaths=99&search-submit=Submit"
HTML = ExecuteWebRequest(Uri)
OutputText (HTML)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFS = oFSO.OpenTextFile(ThisWorkbook.Path & "\temp.html")
Do Until oFS.AtEndOfStream
' sText = oFS.ReadLine 'read line by line
sText = oFS.ReadAll()
Debug.Print sText
Loop
End Sub
Okay so I finally managed to figure this out. The VBA file system object can only read asciiII files, and I had saved mine as unicode. Sometimes, as in my case, saving an asciiII file can cause errors. You can get around this, however, by converting the file to binary, and then back to a string. The details are explained here http://bytes.com/topic/asp-classic/answers/521362-write-xmlhttp-result-text-file.
A bit late to answer but I did this exact thing today (works perfectly):
Sub modify_local_html_file()
Dim url As String
Dim html As Object
Dim fill_a As Object
url = "C:\Myfile.HTML"
Dim oFSO As Object
Dim oFS As Object, sText As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFS = oFSO.OpenTextFile(url)
Do Until oFS.AtEndOfStream
sText = oFS.ReadAll()
Debug.Print sText
Loop
Set html = CreateObject("htmlfile")
html.body.innerHTML = sText
oFS.Close
Set oFS = Nothing
'# grab some element #'
Set fill_a = html.getElementById("val_a")
MsgBox fill_a.innerText
'# change its inner text #'
fill_a.innerText = "20%"
MsgBox fill_a.innerText
'# open file this time to write to #'
Set oFS = oFSO.OpenTextFile(url, 2)
'# write it modified html #'
oFS.write html.body.innerHTML
oFS.Close
Set oFSO = Nothing
Set oFS = Nothing
End Sub