VBSCRIPT上的multidimensional array。 插入到excel
所以我必须从SOAPUI插入数据到Excel，但我有一个问题，直到数据到达买方价格，在这里的图片。
如何插入数据以excel后买方价格？ 我需要multidimensional array或不？
in_result = 1 'arrResult(iResult) = header data = 0 kolom = 1 Dim kolom For iResult = 1 To total_arrResult-1 Step 1 Hasil = Replace(Replace(Replace(Replace(Replace(arrResult(iResult + 1), """", ""), chr(10), ""), "}", ""), "]", ""), " ", "") wait(0.2) arrHasil = Split(Hasil, ",") wait(0.2) ' =================== get "countryCode", "alpha3Code", "numericCode", "shortName" ===================" arrcountryCode = Split(arrHasil(0), ",") arrcountryCode2 = Split(arrcountryCode(0), ":") strcountryCode = Trim(arrcountryCode2(0)) value_countryCode = Trim(arrcountryCode2(1)) wait(0.2) arrbuyprice = Split(arrHasil(17), ",") arrbuyprice2 = Split(arrbuyprice(0), ":") arrbuyprice3 = Split(arrbuyprice2(0), "[") strbuyprice = Trim(arrbuyprice3(0)) value_buyprice = Trim(arrbuyprice3(0)) wait(0.2) '' ======================================================================" kolom = kolom + 1 urutan = iLoop + 1 Call REPORT_EXCEL(No, CaptureFolder, strpathdt, strdt, value_ErrCode, value_ErrMsg, RowCount1, RowCount2, strcountryCode, stralpha3Code, strnumericCode, strshortName, strlastName, strgender, strbirthdate, strcitizenship, stridentno, stridentexp, strbirthplace, strmother, strtax, strmailtwo, strmailthree, strmailfour, strmobile, stremail, strbuyQuota, strsellQuota, value_countryCode, value_alpha3Code, value_mailfour, value_mobile, value_email, value_buyQuota, value_sellQuota, value_ErrResult, kolom, urutan) wait(1) data = 1 Next 虽然它可能在技术上适用于您的示例数据，但JSON并不一定要使用每行的换行符进行良好格式化。 使用Replace()和Split()parsing数据是非常脆弱的，我build议使用像VbsJson这样的工具来正确parsingJSON。 这是一个用日文写的非常古老的页面，但是代码本身对于我所使用的一些系统工作得非常好，在注释中提到了一些小错误修正之后。 为了您的方便，我在这里包含了VBSJson的修改版本。
Class VbsJson ' Author: Demon ' Date: 2012/5/3 ' Website: http://demon.tw/my-work/vbs-json.html Private Whitespace, NumberRegex, StringChunk Private b, f, r, n, t Private Sub Class_Initialize Whitespace = " " & vbTab & vbCr & vbLf b = ChrW(8) f = vbFormFeed r = vbCr n = vbLf t = vbTab Set NumberRegex = New RegExp NumberRegex.Pattern = "(-?(?:0|[1-9]\d*))(\.\d+)?([eE][-+]?\d+)?" NumberRegex.Global = False NumberRegex.MultiLine = True NumberRegex.IgnoreCase = True Set StringChunk = New RegExp StringChunk.Pattern = "([\s\S]*?)([""\\\x00-\x1f])" StringChunk.Global = False StringChunk.MultiLine = True StringChunk.IgnoreCase = True End Sub ' Return a JSON string representation of a VBScript data structure ' Supports the following objects and types ' +-------------------+---------------+ ' | VBScript | JSON | ' +===================+===============+ ' | Dictionary | object | ' | Array | array | ' | String | string | ' | Number | number | ' | True | true | ' | False | false | ' | Null | null | ' +-------------------+---------------+ Public Function Encode(ByRef obj) Dim buf, i, c, g Set buf = CreateObject("Scripting.Dictionary") Select Case VarType(obj) Case vbNull buf.Add buf.Count, "null" Case vbBoolean If obj Then buf.Add buf.Count, "true" Else buf.Add buf.Count, "false" End If Case vbInteger, vbLong, vbSingle, vbDouble buf.Add buf.Count, obj Case vbString buf.Add buf.Count, """" For i = 1 To Len(obj) c = Mid(obj, i, 1) Select Case c Case """" buf.Add buf.Count, "\""" Case "\" buf.Add buf.Count, "\\" Case "/" buf.Add buf.Count, "/" Case b buf.Add buf.Count, "\b" Case f buf.Add buf.Count, "\f" Case r buf.Add buf.Count, "\r" Case n buf.Add buf.Count, "\n" Case t buf.Add buf.Count, "\t" Case Else If AscW(c) >= 0 And AscW(c) <= 31 Then c = Right("0" & Hex(AscW(c)), 2) buf.Add buf.Count, "\u00" & c Else buf.Add buf.Count, c End If End Select Next buf.Add buf.Count, """" Case vbArray + vbVariant g = True buf.Add buf.Count, "[" For Each i In obj If g Then g = False Else buf.Add buf.Count, "," buf.Add buf.Count, Encode(i) Next buf.Add buf.Count, "]" Case vbObject If TypeName(obj) = "Dictionary" Then g = True buf.Add buf.Count, "{" For Each i In obj If g Then g = False Else buf.Add buf.Count, "," buf.Add buf.Count, """" & i & """" & ":" & Encode(obj(i)) Next buf.Add buf.Count, "}" Else Err.Raise 8732,,"None dictionary object" End If Case Else buf.Add buf.Count, """" & CStr(obj) & """" End Select Encode = Join(buf.Items, "") End Function ' Return the VBScript representation of ``str(`` ' Performs the following translations in decoding ' +---------------+-------------------+ ' | JSON | VBScript | ' +===============+===================+ ' | object | Dictionary | ' | array | Array | ' | string | String | ' | number | Double | ' | true | True | ' | false | False | ' | null | Null | ' +---------------+-------------------+ Public Function Decode(ByRef str) Dim idx idx = SkipWhitespace(str, 1) If Mid(str, idx, 1) = "{" Then Set Decode = ScanOnce(str, 1) Else Decode = ScanOnce(str, 1) End If End Function Private Function ScanOnce(ByRef str, ByRef idx) Dim c, ms idx = SkipWhitespace(str, idx) c = Mid(str, idx, 1) If c = "{" Then idx = idx + 1 Set ScanOnce = ParseObject(str, idx) Exit Function ElseIf c = "[" Then idx = idx + 1 ScanOnce = ParseArray(str, idx) Exit Function ElseIf c = """" Then idx = idx + 1 ScanOnce = ParseString(str, idx) Exit Function ElseIf c = "n" And StrComp("null", Mid(str, idx, 4)) = 0 Then idx = idx + 4 ScanOnce = Null Exit Function ElseIf c = "t" And StrComp("true", Mid(str, idx, 4)) = 0 Then idx = idx + 4 ScanOnce = True Exit Function ElseIf c = "f" And StrComp("false", Mid(str, idx, 5)) = 0 Then idx = idx + 5 ScanOnce = False Exit Function End If Set ms = NumberRegex.Execute(Mid(str, idx)) If ms.Count = 1 Then idx = idx + ms(0).Length ScanOnce = CDbl(ms(0)) Exit Function End If Err.Raise 8732,,"No JSON object could be ScanOnced" End Function Private Function ParseObject(ByRef str, ByRef idx) Dim c, key, value Set ParseObject = CreateObject("Scripting.Dictionary") idx = SkipWhitespace(str, idx) c = Mid(str, idx, 1) If c = "}" Then Exit Function ElseIf c <> """" Then Err.Raise 8732,,"Expecting property name" End If idx = idx + 1 Do key = ParseString(str, idx) idx = SkipWhitespace(str, idx) If Mid(str, idx, 1) <> ":" Then Err.Raise 8732,,"Expecting : delimiter" End If idx = SkipWhitespace(str, idx + 1) If Mid(str, idx, 1) = "{" Then Set value = ScanOnce(str, idx) Else value = ScanOnce(str, idx) End If ParseObject.Add key, value idx = SkipWhitespace(str, idx) c = Mid(str, idx, 1) If c = "}" Then Exit Do ElseIf c <> "," Then Err.Raise 8732,,"Expecting , delimiter. Got " & c & " at " & idx End If idx = SkipWhitespace(str, idx + 1) c = Mid(str, idx, 1) If c <> """" Then Err.Raise 8732,,"Expecting property name" End If idx = idx + 1 Loop idx = idx + 1 End Function Private Function ParseArray(ByRef str, ByRef idx) Dim c, values, value Set values = CreateObject("Scripting.Dictionary") idx = SkipWhitespace(str, idx) c = Mid(str, idx, 1) If c = "]" Then idx = idx + 1 ParseArray = values.Items Exit Function End If Do idx = SkipWhitespace(str, idx) If Mid(str, idx, 1) = "{" Then Set value = ScanOnce(str, idx) Else value = ScanOnce(str, idx) End If values.Add values.Count, value idx = SkipWhitespace(str, idx) c = Mid(str, idx, 1) If c = "]" Then Exit Do ElseIf c <> "," Then Err.Raise 8732,,"Expecting , delimiter" End If idx = idx + 1 Loop idx = idx + 1 ParseArray = values.Items End Function Private Function ParseString(ByRef str, ByRef idx) Dim chunks, content, terminator, ms, esc, char Set chunks = CreateObject("Scripting.Dictionary") Do Set ms = StringChunk.Execute(Mid(str, idx)) If ms.Count = 0 Then Err.Raise 8732,,"Unterminated string starting" End If content = ms(0).Submatches(0) terminator = ms(0).Submatches(1) If Len(content) > 0 Then chunks.Add chunks.Count, content End If idx = idx + ms(0).Length If terminator = """" Then Exit Do ElseIf terminator <> "\" Then Err.Raise 8732,,"Invalid control character" End If esc = Mid(str, idx, 1) If esc <> "u" Then Select Case esc Case """" char = """" Case "\" char = "\" Case "/" char = "/" Case "b" char = b Case "f" char = f Case "n" char = n Case "r" char = r Case "t" char = t Case Else Err.Raise 8732,,"Invalid escape" End Select idx = idx + 1 Else char = ChrW("&H" & Mid(str, idx + 1, 4)) idx = idx + 5 End If chunks.Add chunks.Count, char Loop ParseString = Join(chunks.Items, "") End Function Private Function SkipWhitespace(ByRef str, ByVal idx) Do While idx <= Len(str) And _ InStr(Whitespace, Mid(str, idx, 1)) > 0 idx = idx + 1 Loop SkipWhitespace = idx End Function End Class
是的，这是很多代码，但是这将允许你parsing你喜欢的任何 JSON数据。 正如代码注释中提到的那样，它会将对象转换为VB字典，数组转换为vbArrays等等。 要使用它，你会写…
Dim data Set data = (new VbsJson).Decode(rawinput)
（在这种情况下，您必须使用Set ，因为返回的值将是一个对象引用的字典。）
然后你可以通过请求字典条目data("errCode")来获得特定的字段，比如data("errCode") 。
当你得到那么多的时候，你会发现buyPrice是一个对象数组，所以如果你试图做一些像data("buyPrice")(1)那么你将需要再次使用Set 。 当涉及到像这样的多级对象/数组时，VBScript是相当差的，因此您可能需要在这种方式中构build一些额外的variables，例如遍历buyPrice数组。
如果您设法parsingJSON并且需要额外的帮助来遍历结果对象，请通过将其添加到您的问题来更详细地了解我。