Excel VBA JSON POST Loop



我要完成的是遍历特定的表列,并为每个可见行返回该单元格的值。此单元格包含一个公式,该公式根据其他列的表中的值创建 JSON。下面是我要循环访问的列的示例:

Json 输出

在这个循环中,我将使用每个单元格值并 POST JSON,但它需要遍历并发布该列中的每个单元格。这是我用来在没有循环的情况下发布单个单元格的 VBA 代码:

Sub FulcrumUpload()
Dim xhr As Object, thisRequest As String, JSONvalue As String
Set xhr = CreateObject("Microsoft.XMLHTTP")
thisRequest = "https://api.fulcrumapp.com/api/v2/records.json"
xhr.Open "POST", thisRequest, False
xhr.setRequestHeader "Accept", "application/json"
xhr.setRequestHeader "Content-type", "application/json"
xhr.setRequestHeader "X-ApiToken", "11111111111111"
xhr.Send Sheets("Fulcrum Upload").Range("V3").value
End Sub

假设过滤后的数据位于 V 列中,从 V3 开始,可能如下所示:

Public Sub FulcrumUpload()
Dim xhr As Object, thisRequest As String, rng As Range
Set xhr = CreateObject("Microsoft.XMLHTTP")
thisRequest = "https://api.fulcrumapp.com/api/v2/records.json"
With ThisWorkbook.Worksheets("Fulcrum Upload")
For Each rng In .Range("V3:V" & .Cells(.Rows.Count, "V").End(xlUp).Row).SpecialCells(xlVisible)
If Not IsEmpty(rng) Then
With xhr
.Open "POST", thisRequest, False
.setRequestHeader "Accept", "application/json"
.setRequestHeader "Content-type", "application/json"
.setRequestHeader "X-ApiToken", "11111111111111"
.send rng.Value
End With
End If
Next
End With
End Sub

最新更新