Arrays VBSCRIPT上的多维数组。用于插入excel
因此,我必须将数据从SOAPUI插入excel,但在数据到达买方价格之前,我遇到了一个问题,如图所示 如何在购买价格后将数据插入excel??我是否需要多维数组Arrays VBSCRIPT上的多维数组。用于插入excel,arrays,excel,vbscript,soapui,Arrays,Excel,Vbscript,Soapui,因此,我必须将数据从SOAPUI插入excel,但在数据到达买方价格之前,我遇到了一个问题,如图所示 如何在购买价格后将数据插入excel??我是否需要多维数组 in_result = 1 'arrResult(iResult) = header data = 0 kolom = 1 Dim kolom For iResult = 1 To total_arrResult-1 Step 1 Hasil = Replace(Rep
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()
解析数据非常脆弱,我建议使用类似的工具正确解析JSON。这是一个用日语编写的非常旧的页面,但是在注释中提到了一些小错误修复之后,代码本身在我使用的一些系统中运行得非常好。为了您的方便,我在这里包含了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
(在这种情况下,必须使用Set
,因为返回的值将是作为对象引用的字典。)
然后,您可以通过询问字典条目,data(“errCode”)
来获取特定字段,如“errCode”
当你走到这一步时,你会发现buyPrice
是一个对象数组,因此如果你试图做一些类似data(“buyPrice”)(1)
的事情,那么你需要再次使用Set
。当涉及到像这样的多级对象/数组时,VBScript非常糟糕,因此您可能需要在此过程中构建一些额外的变量,例如用于迭代buyPrice数组
如果您在解析JSON时取得了进展,并且需要额外的帮助来遍历生成的对象,只需将其添加到您的问题中,让我了解更多细节
Dim data
Set data = (new VbsJson).Decode(rawinput)