Consider the example below, it does not need https://json-csv.com or any other online service, and not InternetExplorer.Application , so it is more reliable:
Option Explicit Sub GrabQuotesTest() Dim objXHR As Object Dim strCsv As String Dim i As Long Dim strJsonString As String Dim varJson As Variant Dim strState As String Dim varItem As Variant Dim strDesktop As String ' grab google finance data Set objXHR = CreateObject("MSXML2.XMLHTTP.3.0") objXHR.Open "GET", "http://finance.google.com/finance/info?client=ig&q=CVX,XOM,HP,SLB,PBA,ATR,NVZMY,MON,MMM,CNI,EMR,UTX,ROK,XYL,IPGP,DE,JCI,TGT,HD,CVS,NSRGY,PG,PEP,STKL,UNFI,VZ,NGG,POR,ABT,JNJ,NVS,PRGO,RHHBY,ALNY,MDT,ILMN,ISIS,LH,NVO,AFL,CYN,AAPL,ADP,CSCO,EMC,FISV,GOOGL,MA,XLNX,QCOM,INTC,MSFT,NXPI,ORCL", False objXHR.Send Debug.Print objXHR.Status If objXHR.Status <> 200 Then Exit Sub strJsonString = objXHR.responseText ' trim extraneous chars For i = 1 To Len(strJsonString) Select Case Mid(strJsonString, i, 1) Case "[", "{": Exit For End Select Next strJsonString = Mid(strJsonString, i) ' parse json string ParseJson strJsonString, varJson, strState Debug.Print strState If strState = "Error" Then Exit Sub ' convert parsed json to csv strCsv = GetCsv(varJson) ' results output Debug.Print strCsv strDesktop = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") WriteTextFile strCsv, strDesktop & "\Quotes.csv", 0 End Sub Sub ParseJson(ByVal strContent As String, varJson As Variant, strState As String) ' strContent - source JSON string ' varJson - created object or array to be returned as result ' strState - Object|Array|Error depending on processing to be returned as state Dim objTokens As Object Dim objRegEx As Object Dim bMatched As Boolean Set objTokens = CreateObject("Scripting.Dictionary") Set objRegEx = CreateObject("VBScript.RegExp") With objRegEx ' specification http://www.json.org/ .Global = True .MultiLine = True .IgnoreCase = True .Pattern = """(?:\\""|[^""])*""(?=\s*(?:,|\:|\]|\}))" Tokenize objTokens, objRegEx, strContent, bMatched, "str" .Pattern = "(?:[+-])?(?:\d+\.\d*|\.\d+|\d+)e(?:[+-])?\d+(?=\s*(?:,|\]|\}))" Tokenize objTokens, objRegEx, strContent, bMatched, "num" .Pattern = "(?:[+-])?(?:\d+\.\d*|\.\d+|\d+)(?=\s*(?:,|\]|\}))" Tokenize objTokens, objRegEx, strContent, bMatched, "num" .Pattern = "\b(?:true|false|null)(?=\s*(?:,|\]|\}))" Tokenize objTokens, objRegEx, strContent, bMatched, "cst" .Pattern = "\b[A-Za-z_]\w*(?=\s*\:)" ' unspecified name without quotes Tokenize objTokens, objRegEx, strContent, bMatched, "nam" .Pattern = "\s" strContent = .Replace(strContent, "") .MultiLine = False Do bMatched = False .Pattern = "<\d+(?:str|nam)>\:<\d+(?:str|num|obj|arr|cst)>" Tokenize objTokens, objRegEx, strContent, bMatched, "prp" .Pattern = "\{(?:<\d+prp>(?:,<\d+prp>)*)?\}" Tokenize objTokens, objRegEx, strContent, bMatched, "obj" .Pattern = "\[(?:<\d+(?:str|num|obj|arr|cst)>(?:,<\d+(?:str|num|obj|arr|cst)>)*)?\]" Tokenize objTokens, objRegEx, strContent, bMatched, "arr" Loop While bMatched .Pattern = "^<\d+(?:obj|arr)>$" ' unspecified top level array If Not (.Test(strContent) And objTokens.Exists(strContent)) Then varJson = Null strState = "Error" Else Retrieve objTokens, objRegEx, strContent, varJson strState = IIf(IsObject(varJson), "Object", "Array") End If End With End Sub Sub Tokenize(objTokens, objRegEx, strContent, bMatched, strType) Dim strKey As String Dim strRes As String Dim lngCopyIndex As Long Dim objMatch As Object strRes = "" lngCopyIndex = 1 With objRegEx For Each objMatch In .Execute(strContent) strKey = "<" & objTokens.Count & strType & ">" bMatched = True With objMatch objTokens(strKey) = .Value strRes = strRes & Mid(strContent, lngCopyIndex, .FirstIndex - lngCopyIndex + 1) & strKey lngCopyIndex = .FirstIndex + .Length + 1 End With Next strContent = strRes & Mid(strContent, lngCopyIndex, Len(strContent) - lngCopyIndex + 1) End With End Sub Sub Retrieve(objTokens, objRegEx, strTokenKey, varTransfer) Dim strContent As String Dim strType As String Dim objMatches As Object Dim objMatch As Object Dim strName As String Dim varValue As Variant Dim objArrayElts As Object strType = Left(Right(strTokenKey, 4), 3) strContent = objTokens(strTokenKey) With objRegEx .Global = True Select Case strType Case "obj" .Pattern = "<\d+\w{3}>" Set objMatches = .Execute(strContent) Set varTransfer = CreateObject("Scripting.Dictionary") For Each objMatch In objMatches Retrieve objTokens, objRegEx, objMatch.Value, varTransfer Next Case "prp" .Pattern = "<\d+\w{3}>" Set objMatches = .Execute(strContent) Retrieve objTokens, objRegEx, objMatches(0).Value, strName Retrieve objTokens, objRegEx, objMatches(1).Value, varValue If IsObject(varValue) Then Set varTransfer(strName) = varValue Else varTransfer(strName) = varValue End If Case "arr" .Pattern = "<\d+\w{3}>" Set objMatches = .Execute(strContent) Set objArrayElts = CreateObject("Scripting.Dictionary") For Each objMatch In objMatches Retrieve objTokens, objRegEx, objMatch.Value, varValue If IsObject(varValue) Then Set objArrayElts(objArrayElts.Count) = varValue Else objArrayElts(objArrayElts.Count) = varValue End If Next varTransfer = objArrayElts.Items Case "nam" varTransfer = strContent Case "str" varTransfer = Mid(strContent, 2, Len(strContent) - 2) varTransfer = Replace(varTransfer, "\""", """") varTransfer = Replace(varTransfer, "\\", "\") varTransfer = Replace(varTransfer, "\/", "/") varTransfer = Replace(varTransfer, "\b", Chr(8)) varTransfer = Replace(varTransfer, "\f", Chr(12)) varTransfer = Replace(varTransfer, "\n", vbLf) varTransfer = Replace(varTransfer, "\r", vbCr) varTransfer = Replace(varTransfer, "\t", vbTab) .Global = False .Pattern = "\\u[0-9a-fA-F]{4}" Do While .Test(varTransfer) varTransfer = .Replace(varTransfer, ChrW(("&H" & Right(.Execute(varTransfer)(0).Value, 4)) * 1)) Loop Case "num" varTransfer = Eval(strContent) Case "cst" Select Case LCase(strContent) Case "true" varTransfer = True Case "false" varTransfer = False Case "null" varTransfer = Null End Select End Select End With End Sub Function GetCsv(arrItems) Dim strRowSep As String Dim strDecDelim As String Dim strColSep As String Dim strKey As Variant Dim lngPrevIdx As Long Dim lngFoundIdx As Long Dim arrHeader() As String Dim arrColumns() As String Dim arrRows() As String Dim i As Long Dim j As Long Dim objItem As Variant Dim varValue As Variant strRowSep = vbCrLf ' strDecDelim = Mid(0.1, 2, 1) If strDecDelim = "." Then strColSep = "," Else strColSep = ";" End If If SafeUBound(arrItems) = -1 Then GetCsv = "No rows" Exit Function End If For Each objItem In arrItems lngPrevIdx = -1 For Each strKey In objItem.Keys lngFoundIdx = GetArrayItemIndex(arrHeader, strKey) If lngFoundIdx = -1 Then If lngPrevIdx = -1 Then ArrayAddItem arrHeader, strKey lngPrevIdx = UBound(arrHeader) Else ArrayInsertItem arrHeader, lngPrevIdx + 1, strKey lngPrevIdx = lngPrevIdx + 1 End If Else lngPrevIdx = lngFoundIdx End If Next Next If SafeUBound(arrHeader) = -1 Then GetCsv = "No columns" Exit Function End If GetCsv = Join(arrHeader, strColSep) & strRowSep ReDim arrColumns(UBound(arrHeader)) ReDim arrRows(UBound(arrItems)) For i = 0 To UBound(arrItems) Set objItem = arrItems(i) For j = 0 To UBound(arrHeader) strKey = arrHeader(j) varValue = objItem(strKey) Select Case VarType(varValue) Case vbInteger, vbLong, vbSingle, vbDouble arrColumns(j) = varValue Case vbNull arrColumns(j) = "Null" Case vbBoolean arrColumns(j) = IIf(varValue, "True", "False") Case vbString arrColumns(j) = """" & varValue & """" Case Else arrColumns(j) = "" End Select Next arrRows(i) = Join(arrColumns, strColSep) Next GetCsv = GetCsv & Join(arrRows, strRowSep) End Function Function GetArrayItemIndex(arrElements, varTest) For GetArrayItemIndex = 0 To SafeUBound(arrElements) If arrElements(GetArrayItemIndex) = varTest Then Exit Function Next GetArrayItemIndex = -1 End Function Sub ArrayAddItem(arrElements, varElement) ReDim Preserve arrElements(SafeUBound(arrElements) + 1) arrElements(UBound(arrElements)) = varElement End Sub Sub ArrayInsertItem(arrElements, lngIndex, varElement) Dim i As Long ReDim Preserve arrElements(SafeUBound(arrElements) + 1) For i = UBound(arrElements) To lngIndex + 1 Step -1 arrElements(i) = arrElements(i - 1) Next arrElements(i) = varElement End Sub Function SafeUBound(arrTest) On Error Resume Next SafeUBound = -1 SafeUBound = UBound(arrTest) End Function Sub WriteTextFile(strContent As String, strPath As String, lngFormat As Long) ' lngFormat -2 - System default, -1 - Unicode, 0 - ASCII With CreateObject("Scripting.FileSystemObject").OpenTextFile(strPath, 2, True, lngFormat) .Write (strContent) .Close End With End Sub
This example works in Access VBA to run it in Excel to replace the Eval function with Evaluate .