VBA Makro Load Data from Website with Java Script

[Silent]

hi all,

i want to load some table data from a java script website.

i use excel query connection and open the excel browser (think it is a old IE) and answer some scripts error message with "no, do not continue the script" and then the website loading and i close the excel browser and the macro works.

With ActiveSheet.QueryTables.Add(Connection:= _ "URL;https://musterfirma.coupahost.com/receipts?cond%5B1%5D%5Bcol_key%5D=order_header_id&cond%5B1%5D%5Border_header_id%5D=01039506&cond%5B1%5D%5Border_header_id_op%5D=eq&search_mode=advanced (https://deref-web-02.de/mail/client/TNfuRxHtD3c/dereferrer/?redirectUrl=https%3A%2F%2Famazon.coupahost.com%2Freceipts%3Fcond%255B1%255 D%255Bcol_key%255D%3Dorder_header_id%26cond%255B1%255D%255Border_header_id% 255D%3D01039506%26cond%255B1%255D%255Border_header_id_op%255D%3Deq%26search _mode%3Dadvanced)" _

, Destination:=Range("$A$1"))
.CommandType = 0
.Name = _

"receipts?cond%5B1%5D%5Bcol_key%5D=order_header_id&cond%5B1%5D%5Border_header_id%5D=1375421&cond%5B1%5D%5Border_header_id_op%5D=eq&search_mode=advanced"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone

.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub

But today nothing work. This Error message appears:
Note: Since your browser does not support JavaScript, you must press the Resume button once to proceed.



ok it just load if i open the query and click error message and close the browser.

Ok i think the website need cookies or a token ( i find some line in the website text) . Where can i see what the website needs to login and work fine?


I test this marco but error was "forbidden"



Sub Dow_HistoricalData()

Dim xmlHttp As Object
Dim TR_col As Object, TR As Object
Dim TD_col As Object, TD As Object
Dim row As Long, col As Long

Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
xmlHttp.Open "GET", "https://musterfirma.coupahost.com/receipts?cond%5B1%5D%5Bcol_key%5D=order_header_id&cond%5B1%5D%5Border_header_id%5D=1372229&cond%5B1%5D%5Border_header_id_op%5D=eq&search_mode=advanced (https://deref-web-02.de/mail/client/TNfuRxHtD3c/dereferrer/?redirectUrl=https%3A%2F%2Famazon.coupahost.com%2Freceipts%3Fcond%255B1%255 D%255Bcol_key%255D%3Dorder_header_id%26cond%255B1%255D%255Border_header_id% 255D%3D1372229%26cond%255B1%255D%255Border_header_id_op%255D%3Deq%26search_ mode%3Dadvanced)", False

xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.Send

Dim html As Object
Set html = CreateObject("htmlfile")
html.body.innerHTML = xmlHttp.responseText

Dim tbl As Object
Set tbl = html.getElementById("curr_table")

row = 1
col = 1

Set TR_col = html.getelementsbytagname("TR")
For Each TR In TR_col
Set TD_col = TR.getelementsbytagname("TD")
For Each TD In TD_col
Cells(row, col) = TD.innerText
col = col + 1
Next
col = 1
row = row + 1
Next
End Sub

here the line with the token:


<title>Empfangen</title>
<link href='/assets/favicon-cd941e7bee11ad2e862dc6b9b22bd4731c50c6c90339ce35d27cf01571ce69c2.ico' rel='shortcut icon'>
<meta name="csrf-param" content="authenticity_token" />
<meta name="csrf-token" content="WfrZaKKkNDZHkZmad1/GO/qe2oQghoPKkCWTEcD7GD0P1evo8OHgByyDajZg821gxSjc8kb470+AM4P9qXrTtw==" />
<!--[if lt IE 9]>
<script src="/assets/html5-e3b




what code works that the macro login with token? or cookie or something and loading the table data?

Thx and cheers

Silent