将 Excel 数据转换为 JSON，然后将 Post 转换为 API

Question

我一直在使用下面的代码将 excel 数据的数量转换为 json 文件，如 exportedxls.json 我想将此数据发送到 API

Sub converttojson()
    savename = "exportedxls.json"
    Dim wkb As Workbook
    Dim wks As Worksheet
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets(1)
    lcolumn = wks.Cells(1, Columns.Count).End(xlToLeft).Column
    lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
    Dim titles() As String
    ReDim titles(lcolumn)
    For i = 1 To lcolumn
        titles(i) = wks.Cells(1, i)
    Next i
    json = "["
    dq = """"
    For j = 2 To lrow
        For i = 1 To lcolumn
            If i = 1 Then
                json = json & "{"
            End If
            cellvalue = wks.Cells(j, i)
            json = json & dq & titles(i) & dq & ":" & dq & cellvalue & dq
            If i <> lcolumn Then
                json = json & ","
            End If
        Next i
        json = json & "}"
        If j <> lrow Then
            json = json & ","
        End If
    Next j
    json = json & "]"
    myFile = Application.DefaultFilePath & "\" & savename
    Open myFile For Output As #1
    Print #1, json
    Close #1
    a = MsgBox("Saved as " & savename, vbOKOnly)
End Sub

这里是 post json 代码。但我无法知道下面的代码如何将上面的 json 发送到 api。

我想将这两个代码都用作单个代码，当代码运行它将在一次调用中将 post 转换为 api。非常感谢您的帮助。

'VBA function to send HTTP POST to a server:
    Function httpPost$(url$, msg$)
        With CreateObject("WinHttp.WinHttpRequest.5.1")
            .Open "POST", url, False
            .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
            .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
            '.setRequestHeader "secret-pass-key", "your-key"    <--if needed
            .send msg
            httpPost = .responseText
        End With
    End Function

Answer 1

注意：建议始终声明您的变量及其适当的变量类型，使用模块顶部的 Option Explicit 来帮助您。

下面是根据您的代码修改的示例，运行 ConvertAndSend 将：

从 ConvertJSON 函数中获取 JSON 字符串作为 apiJSON。
将 apiJSON 作为参数传递给 httpPost，然后 return .responseText 作为 apiResponse.

请参阅有关 Content-Type header and/or 其他要求的 API 文档。

Option Explicit

Sub ConvertAndSend()
    Dim apiJSON As String
    apiJSON = ConvertJSON
    
    Dim apiResponse As String
    apiResponse = httpPost("put in api endpoint url", apiJSON)
End Sub

Function ConvertJSON() As String
    
    Dim wkb As Workbook
    Dim wks As Worksheet
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets(1)
            
    Dim lcolumn As Long
    lcolumn = wks.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Dim lrow As Long
    lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
    
    Dim titles() As String
    ReDim titles(lcolumn)
    Dim i As Long
    For i = 1 To lcolumn
        titles(i) = wks.Cells(1, i)
    Next i
    
    Dim json As String
    json = "["
    
    Dim dq As String
    
    dq = """"
    
    Dim j As Long
    For j = 2 To lrow
        For i = 1 To lcolumn
            If i = 1 Then
                json = json & "{"
            End If
            
            Dim cellvalue As Variant 'or declare as String
            cellvalue = wks.Cells(j, i)
            json = json & dq & titles(i) & dq & ":" & dq & cellvalue & dq
            If i <> lcolumn Then
                json = json & ","
            End If
        Next i
        json = json & "}"
        If j <> lrow Then
            json = json & ","
        End If
    Next j
    ConvertJSON = json & "]"
End Function

Function httpPost(url As String, msg As String) As String
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", url, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"    'Don't think it's necessary
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"   'Consult API documentation on the required Content-Type
        '.setRequestHeader "secret-pass-key", "your-key"    <--if needed
        .send msg
        httpPost = .responseText
    End With
End Function

将 Excel 数据转换为 JSON，然后将 Post 转换为 API

Convert Excel data to JSON then Post to API

excel

post

vba

http