gpt4 book ai didi

json - 正确解析 JSON 响应文本

转载 作者:行者123 更新时间:2023-12-04 22:29:46 27 4
gpt4 key购买 nike

我正在创建的 Excel 程序中有问题。简而言之,我必须从网站中提取 JSON 数据,对其进行解析,然后将响应扔到工作表中以供以后使用。每当代码到达要输出响应文本的位置时,输出就会从响应文本中传递我需要的第一组数据。以下所有数据和示例。

创建和发送 HTTP 请求的代码:

For i = 1 To 100
URL = "REDACTED"

Set httpRequest = CreateObject("MSXML2.XMLHTTP")
httpRequest.Open "GET", URL, False
httpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
httpRequest.send ""

Set Output = parse(httpRequest.responseText)

Pallet_Inv.Cells(1 + i, d) = Output.Item("result").Item("contains").Item(i).Item("resourceLabel")

Next

Pallet_Inv 是响应文本需要输出到的工作表。
“(1 + i,d)”在那里,因为我在工作表上有一个标题,输出将转到我不想被覆盖的地方。

解析从请求返回的响应文本的代码:
Public Function parse(ByRef str As String) As Object

Dim Index As Long
Index = 1
psErrors = ""
On Error Resume Next
Call skipChar(str, Index)
Select Case Mid(str, Index, 1)
Case "{"
Set parse = parseObject(str, Index)
Case "["
Set parse = parseArray(str, Index)
Case Else
psErrors = "Invalid JSON"
End Select


End Function
' skip special character
'
Private Sub skipChar(ByRef str As String, ByRef Index As Long)
Dim bComment As Boolean
Dim bStartComment As Boolean
Dim bLongComment As Boolean
Do While Index > 0 And Index <= Len(str)
Select Case Mid(str, Index, 1)
Case vbCr, vbLf
If Not bLongComment Then
bStartComment = False
bComment = False
End If

Case vbTab, " ", "(", ")"

Case "/"
If Not bLongComment Then
If bStartComment Then
bStartComment = False
bComment = True
Else
bStartComment = True
bComment = False
bLongComment = False
End If
Else
If bStartComment Then
bLongComment = False
bStartComment = False
bComment = False
End If
End If

Case "*"
If bStartComment Then
bStartComment = False
bComment = True
bLongComment = True
Else
bStartComment = True
End If

Case Else
If Not bComment Then
Exit Do
End If
End Select

Index = Index + 1
Loop

End Sub
'
' parse collection of key/value
'
Private Function parseObject(ByRef str As String, ByRef Index As Long) As Dictionary

Set parseObject = New Dictionary
Dim sKey As String

' "{"
Call skipChar(str, Index)
If Mid(str, Index, 1) <> "{" Then
psErrors = psErrors & "Invalid Object at position " & Index & " : " & Mid(str, Index) & vbCrLf
Exit Function
End If

Index = Index + 1

Do
Call skipChar(str, Index)
If "}" = Mid(str, Index, 1) Then
Index = Index + 1
Exit Do
ElseIf "," = Mid(str, Index, 1) Then
Index = Index + 1
Call skipChar(str, Index)
ElseIf Index > Len(str) Then
psErrors = psErrors & "Missing '}': " & Right(str, 20) & vbCrLf
Exit Do
End If


' add key/value pair
sKey = parseKey(str, Index)
On Error Resume Next

parseObject.Add sKey, parseValue(str, Index)
If Err.Number <> 0 Then
psErrors = psErrors & Err.Description & ": " & sKey & vbCrLf
Exit Do
End If
Loop
eh:

End Function

Private Function parseKey(ByRef str As String, ByRef Index As Long) As String

Dim dquote As Boolean
Dim squote As Boolean
Dim Char As String

Call skipChar(str, Index)
Do While Index > 0 And Index <= Len(str)
Char = Mid(str, Index, 1)
Select Case (Char)
Case """"
dquote = Not dquote
Index = Index + 1
If Not dquote Then
Call skipChar(str, Index)
If Mid(str, Index, 1) <> ":" Then
psErrors = psErrors & "Invalid Key at position " & Index & " : " & parseKey & vbCrLf
Exit Do
End If
End If
Case "'"
squote = Not squote
Index = Index + 1
If Not squote Then
Call skipChar(str, Index)
If Mid(str, Index, 1) <> ":" Then
psErrors = psErrors & "Invalid Key at position " & Index & " : " & parseKey & vbCrLf
Exit Do
End If
End If
Case ":"
Index = Index + 1
If Not dquote And Not squote Then
Exit Do
Else
parseKey = parseKey & Char
End If
Case Else
If InStr(vbCrLf & vbCr & vbLf & vbTab & " ", Char) Then
Else
parseKey = parseKey & Char
End If
Index = Index + 1
End Select
Loop

End Function
'
' parse string / number / object / array / true / false / null
'
Private Function parseValue(ByRef str As String, ByRef Index As Long)

Call skipChar(str, Index)

Select Case Mid(str, Index, 1)
Case "{"
Set parseValue = parseObject(str, Index)
Case "["
Set parseValue = parseArray(str, Index)
Case """", "'"
parseValue = parseString(str, Index)
Case "t", "f"
parseValue = parseBoolean(str, Index)
Case "n"
parseValue = parseNull(str, Index)
Case Else
parseValue = parseNumber(str, Index)
End Select

End Function
'
' parse list
'
Private Function parseArray(ByRef str As String, ByRef Index As Long) As Collection

Set parseArray = New Collection

' "["
Call skipChar(str, Index)
If Mid(str, Index, 1) <> "[" Then
psErrors = psErrors & "Invalid Array at position " & Index & " : " + Mid(str, Index, 20) & vbCrLf
Exit Function
End If

Index = Index + 1

Do

Call skipChar(str, Index)
If "]" = Mid(str, Index, 1) Then
Index = Index + 1
Exit Do
ElseIf "," = Mid(str, Index, 1) Then
Index = Index + 1
Call skipChar(str, Index)
ElseIf Index > Len(str) Then
psErrors = psErrors & "Missing ']': " & Right(str, 20) & vbCrLf
Exit Do
End If

' add value
On Error Resume Next
parseArray.Add parseValue(str, Index)
If Err.Number <> 0 Then
psErrors = psErrors & Err.Description & ": " & Mid(str, Index, 20) & vbCrLf
Exit Do
End If
Loop

End Function
'
' parse number
'
Private Function parseNumber(ByRef str As String, ByRef Index As Long)

Dim Value As String
Dim Char As String

Call skipChar(str, Index)
Do While Index > 0 And Index <= Len(str)
Char = Mid(str, Index, 1)
If InStr("+-0123456789.eE", Char) Then
Value = Value & Char
Index = Index + 1
Else
parseNumber = CDec(Value)
Exit Function
End If
Loop
End Function
'
' parse string
'
Private Function parseString(ByRef str As String, ByRef Index As Long) As String

Dim quote As String
Dim Char As String
Dim Code As String

Dim SB As New cStringBuilder

Call skipChar(str, Index)
quote = Mid(str, Index, 1)
Index = Index + 1

Do While Index > 0 And Index <= Len(str)
Char = Mid(str, Index, 1)
Select Case (Char)
Case "\"
Index = Index + 1
Char = Mid(str, Index, 1)
Select Case (Char)
Case """", "\", "/", "'"
SB.Append Char
Index = Index + 1
Case "b"
SB.Append vbBack
Index = Index + 1
Case "f"
SB.Append vbFormFeed
Index = Index + 1
Case "n"
SB.Append vbLf
Index = Index + 1
Case "r"
SB.Append vbCr
Index = Index + 1
Case "t"
SB.Append vbTab
Index = Index + 1
Case "u"
Index = Index + 1
Code = Mid(str, Index, 4)
SB.Append ChrW(Val("&h" + Code))
Index = Index + 4
End Select
Case quote
Index = Index + 1

parseString = SB.toString
Set SB = Nothing

Exit Function

Case Else
SB.Append Char
Index = Index + 1
End Select
Loop

parseString = SB.toString
Set SB = Nothing

End Function

来自网站的原始 JSON 数据:

{"result":{"contains":[{"cptInMillis":1547531880000,"containerType":"Case
","cpt":"REDACTED
PM","stackingFilter":"REDACTED","associationReason":"-","isEmpty":"-","resourceLabel":"csXP25jMSzG","associatedUser":"REDACTED","cleanupAllowed":false,"isClosed":"-","containerId":"REDACTED","isForcedMove":"No","dwellTime":"REDACTED
: 1"},{"cptInMillis":1547531880000,"containerType":"Case
","cpt":"REDACTED
PM","stackingFilter":"REDACTED","associationReason":"-","isEmpty":"-","resourceLabel":"csXP25jMTHk","associatedUser":"REDACTED","cleanupAllowed":false,"isClosed":"-","containerId":"REDACTED","isForcedMove":"No","dwellTime":"REDACTED
: 2"},{"cptInMillis":1547531880000,"containerType":"Case
","cpt":"REDACTED
PM","stackingFilter":"REDACTED","associationReason":"-","isEmpty":"-","resourceLabel":"csXP25jMTN5","associatedUser":"REDACTED","cleanupAllowed":false,"isClosed":"-","containerId":"REDACTED","isForcedMove":"No","dwellTime":"REDACTED
: 2"},{"cptInMillis":1547445480000,"containerType":"Case
","cpt":"REDACTED
PM","stackingFilter":"REDACTED","associationReason":"-","isEmpty":"-","resourceLabel":"csXP25k9Z5F","associatedUser":"REDACTED","cleanupAllowed":false,"isClosed":"-","containerId":"REDACTED","isForcedMove":"No","dwellTime":"REDACTED
: 2"}],"endToken":null,"startToken":"0"},"ok":true,"message":""}

现在由于一些数据是 secret 的,我已经对其进行了编辑,但是我真正需要的东西我已经保留了。

我需要在此处添加的 JSON 数据中存在的“resourceLabel”对象。

现在我确实得到了数据,但是它开始在第二个“resourceLabel”对象而不是第一个输出。

我需要的:
csXP25jMSzG  csXP25jMTHk  csXP25jMTN5  csXP25k9Z5F

我不断得到的:
csXP25jMTHk
csXP25jMTN5
csXP25k9Z5F

现在我可能只是遗漏了一些明显的东西,但我不确定为什么会这样。如果这个问题太复杂,太长,或者解释不够,请告诉我。或者,如果 Stack 不是此类问题的正确位置,请指导我去其他地方。

任何帮助,将不胜感激。
谢谢你。

最佳答案

除非您的主要目标是编写 JSON 解析器,否则我建议您使用现有的 JSON 转换器。我一直在使用 GitHub 中的那个.使用该转换器,获得resourceLabel 相对容易。 .这是一种方法:

Option Explicit
Sub pj()
Dim strJSON As String
Dim JSON As Dictionary
Dim dRES As Dictionary
Dim oContains As Collection
Dim V

strJSON = Cells(1, 1).Value2
Set JSON = parsejson(strJSON)
Set dRES = JSON("result")
Set oContains = dRES("contains")

For Each V In oContains
Debug.Print V("resourceLabel")
Next V

End Sub

使用 A1 中的 JSON 字符串, 输出:
csXP25jMSzG
csXP25jMTHk
csXP25jMTN5
csXP25k9Z5F

关于json - 正确解析 JSON 响应文本,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/54164891/

27 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com