json - 正确解析 JSON 响应文本-6ren

json - 正确解析 JSON 响应文本

转载作者：行者123 更新时间：2023-12-04 22:29:46

我正在创建的 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/

文章推荐： r - data.table:用矩阵更新 data.table 中的多列

文章推荐： php - Yii2 传递参数给邮件布局

文章推荐： excel，其他选项卡中的条件格式

javascript - 如果输入 a 或 b 正确/正确，我如何执行操作？
这个问题已经有答案了: How to do case insensitive string comparison? (23 个回答) 已关闭 3 年前。用户在我的输入栏中写入“足球”，然后执行第 6
javascript - 字符 id= + 是 + 正确= + 正确不正确...我怎样才能使它成为 javascript 中的字符串
啊，不习惯 javascript 中的字符串。 character_id= + id + correct= + correctOrIncorrect 这就是我需要制作成字符串的内容。如果您无法猜测字符
javascript - jQuery计算价格不起作用(正确)
$(function() { var base_price = 0; CalculatePrice(); $(".math1").on('change', function(e) { Calc
kubernetes - 将Spinnaker部署到Spinnaker将管理的同一kubernetes集群是否安全/正确？
我找不到任何文章回答问题:将Spinnaker部署到Spinnaker将管理的同一Kubernetes集群是否安全/正确？我主要是指生产，HA部署。最佳答案我认为Spinnaker和Kuberne
c++ - 正确/快速的方法来更改命令行Qt5源内部版本的配置
我正在使用MSVC在Windows上从源代码(官方源代码发布，而不是从仓库中)构建Qt5(Qt 5.15.0)。我正在设置环境。变量，依赖项等，然后运行具有1600万个选项的configure，最后
java - 计数时数组越界[正确]
我需要打印一个包含重复单词的数组。我的数组已经可以工作，但我不知道如何正确计算单词数。我已经知道，当我的索引计数器 (i) 为 49 时，并且当 (i) 想要计数到 50 时，我会收到错误，但我不知道
javascript - 正确/错误取决于屏幕尺寸动态？
我正在遵循一个指南，该指南允许 Google map 屏幕根据屏幕尺寸禁用滚动。我唯一挣扎的部分是编写一个代码，当我手动调整屏幕大小时动态更改 True/False 值。这是我按照说明操作的网站，但
java - 未调用子类中的方法(正确)
我有一个类“FileButton”。它的目的是将文件链接到 JButton，FileButton 继承自 JButton。子类继承自此以使用链接到按钮的文件做有用的事情。 JingleCardButt
php - 如何仅显示来自好友列表的帖子。 (正确)
我的 friend 数组只返回一个数字而不是所有数字。 ($myfriends = 3) 应该是…… ($myfriends = 3 5 7 8 9 12). 如果我让它进入 while 循环……整个
html - 在这种情况下使用整数作为类名是否可以接受/正确
这个问题在这里已经有了答案: Is there a workaround to make CSS classes with names that start with numbers valid?
javascript - 在窗口更改时自动调整元素大小(正确)
我正在制作一个 JavaScript 函数，当调整窗口大小时，它会自动将 div 的大小调整为与窗口相同的宽度/高度。该功能非常基本，但我注意到在调整窗口大小时出现明显的“绘制”滞后。在 JS fi
javascript - 删除导航栏的类 - 正确
此问题的基本视觉效果可在 http://sevenx.de/demo/bootstrap-carousel/inc.carousel/tabbed-slider.html 获得。 - 如果你想看一看。
c - 从将其内存分配给同一函数的函数返回字符串是否安全/正确？
我明白，如果我想从函数返回一个字符串文字或一个数组，我应该将其声明为静态的，这样当被调用的函数被返回时，内容就不会“消亡”。但我的问题是，当我在函数内部使用 malloc 分配内存时会怎样？在下面
mysql - 正确/错误值的适当数据字段类型？
在 mySQL 数据库中存储 true/false/1/0 值最合适(读取数据消耗最少)的数据字段是什么？我以前使用过一个字符长的 tinyint，但我不确定它是否是最佳解决方案？谢谢! 最佳答案
c++ - 正确，有效地读取文件
我想一次读取并处理CSV文件第一行中的条目(例如打印)。我假设使用Unix风格的\n换行符，没有条目长度超过255个字符，并且(现在)在EOF之前有一个换行符。这意味着它是fgets()后跟strto
c++ - “正确”无符号整数比较
所以，我们都知道 -1 > 2u == true 的 C/C++ 有符号/无符号比较规则，并且我有一种情况，我想有效地实现“正确”比较。我的问题是，考虑到人们熟悉的尽可能多的架构，哪种方法更有效。显
Java异常处理：如何写出“正确”但被编译器认为有语法错误的程序
**摘要：**文章的标题看似自相矛盾。本文分享自华为云社区《Java异常处理：如何写出“正确”但被编译器认为有语法错误的程序》，作者： Jerry Wang 。文章的标题看似自相矛盾，然而我在“正
r - 进行按行替换的“正确”方法
我有一个数据框，看起来像: dataDemo % mutate_each(funs(ifelse(. == '.', REF, as.character(.))), -POS) # POS REF
text - VBScript 正确/重新格式化带分隔符的文本文件？
有人可以帮助我使用 VBScript 重新格式化/正确格式化带分隔符的文本文件吗？我有一个文本文件 ^分界如下: AGREE^NAME^ADD1^ADD2^ADD3^ADD4^PCODE^BAL^A
java - 语言认证以及诸如适当、正确、合法等术语的使用
就目前而言，这个问题不适合我们的问答形式。我们希望答案得到事实、引用或专业知识的支持，但这个问题可能会引起辩论、争论、投票或扩展讨论。如果您觉得这个问题可以改进并可能重新打开，visit the he

行者123

个人简介

我是一名优秀的程序员,十分优秀！

作者热门文章

滴滴打车优惠券免费领取

全站热门文章

首页

博学

6Ren·AI

商城

json - 正确解析 JSON 响应文本