2017-08-04 31 views
1

をExcelに挿入するために私が優れてSOAPUIからデータを挿入する必要がありますが、データは、ここで買い手の価格、絵に到着するまで、私は問題を抱えています。 buyerprice後にデータをExcelに挿入する方法VBSCRIPTの多次元配列。

Problem picture

?私は多次元配列が必要かどうか?

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 

答えて

2

それは技術的にここにあなたの例のデータのために働くかもしれませんが、JSONは、必ずしも各フィールドの改行をきれいにフォーマットする必要はありません。 Replace()Split()を使用してデータの解析は非常に脆弱であり、私は適切にJSONを解析VbsJsonのようなツールを使用することをお勧めします。これは日本語で書かれた非常に古いページですが、コード自体は、コメントに記載されたいくつかのマイナーなバグ修正した後、私が一緒に仕事いくつかのシステムのために非常に適しています。私は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 

はい、それは多くのコードですが、これはあなたがあなたが好きな JSONデータを解析することができます。コードコメントで述べたように、オブジェクトをVB辞書、vbArrayへの配列などに変換します。それを使用するには、...

Dim data 
Set data = (new VbsJson).Decode(rawinput) 

(返された値がオブジェクト参照である辞書になりますので、あなたは、このケースでSetを使用する必要があります。)

を書きます。そして、あなたは得ることができます辞書エントリを尋ねることによって "errCode"のような特定のフィールドを出す。data("errCode")

これまでのところでは、buyPriceはオブジェクトの配列なので、data("buyPrice")(1)のような操作をしようとするともう一度Setを使用する必要があります。それは、このような複数レベルのオブジェクト/配列にダイビングに来るときあなたは、このようなbuyPrice配列を繰り返し処理用として、道に沿っていくつかの余分な変数を構築する必要がある場合がありますので、VBScriptのは、かなり貧弱です。

あなたはJSONをパース進捗状況を作るために管理し、結果のオブジェクトを横断追加のヘルプが必要な場合は、ちょうど私があなたの質問に追加することで、より詳細に知らせてください。

+0

感謝の先生は、私が最初に試してみましょう:)ありがとうは非常に –

+0

はすべてが大丈夫うまくましたか? – BoffinbraiN