Files
standardpsi/getArticleData.bas

74 lines
2.0 KiB
QBasic

Attribute VB_Name = "getArticleData"
public sub getArticleData()
Dim port as string
Dim req As New WinHttpRequest
Dim statusMessage as string
dim url as string
Dim json As Object
Dim dataArray As Object
dim headerRow as range
dim h as Integer
Dim cellValue As Variant
Dim rowIndex As Integer
' The server and url stuff will change once we move to the new version of lst running on go in iis
server = Sheets("Setup Data").Range("B5").Value
token = Sheets("Setup Data").Range("B6").Value
articles = Sheets("Setup Data").Range("B4").value
port = 3000
if token = "usiow2" then
port = 3001
end if
url = "http://" & server & ":" &port &"/api/datamart/psiarticledata?avs=" & articles
debug.print url
req.Open "GET", url, False
req.Send
jsonResponse = req.ResponseText
Set json = JsonConverter.ParseJson(jsonResponse)
If req.Status <> 200 Then
'"Message: " & req.StatusText & vbNewLine &
message = "StatusCode " & req.Status & vbNewLine & _
"Message : " & json("message")
MsgBox message, vbInformation, "Server Error"
End If
Set dataArray = json("data")
Set headerRow = Sheets("Setup Data").Range("A18")
If req.Status = 200 Then
' add the headers
h = 1
for each Item in dataArray(1).Keys
if Item <> "Id" then
headerRow.Cells(1, h).value = Item
h = h +1
end if
next Item
rowIndex = 19 'starts at this row
For j = 1 To dataArray.Count
For x = 1 To h
cellValue = dataArray(j)(headerRow.Cells(1, x).Value)
Debug.Print "Header: " & dataArray(j)(headerRow.Cells(1, x).Value)
If VarType(cellValue) = vbString Then
Sheets("Setup Data").Cells(rowIndex, x).Value = "'" & cellValue ' Prefixing with apostrophe forces Excel to treat it as text
Else
Sheets("Setup Data").Cells(rowIndex, x).Value = cellValue
End If
Next x
rowIndex = rowIndex + 1 ' Move to the next row
Next j
end if
end sub