web json verilerini excel sayfasına alma

[işsiz123]

Merhabalar web sayfadaki json verilerini excel sayfasına alta alta nasıl alabilirim. json web linki

 

[Zeki Gürsoy]

Sub test()
   
    strJson = "  buraya webden json string "
   
    arrPat = Array("\""(-MUE.+?)(?="":)", """EMN"":""(.+?)(?="",)", "local machine"":""(.+?)(?="",)", "Unix epoch"":(.+?)(?=\})")

    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
   
    rCount = 0
    cCount = 0
   
    For Each pat In arrPat
       
        cCount = cCount + 1
       
        reg.Pattern = pat
       
        For Each m In reg.Execute(strJson)
       
            rCount = rCount + 1
           
            Cells(rCount, cCount) = m.SubMatches(0)
           
        Next
       
        rCount = 0
       
    Next       
   
End Sub

 

[işsiz123]

Sub test()
  
    strJson = "  buraya webden json string "
  
    arrPat = Array("\""(-MUE.+?)(?="":)", """EMN"":""(.+?)(?="",)", "local machine"":""(.+?)(?="",)", "Unix epoch"":(.+?)(?=\})")

    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = True
  
    rCount = 0
    cCount = 0
  
    For Each pat In arrPat
      
        cCount = cCount + 1
      
        reg.Pattern = pat
      
        For Each m In reg.Execute(strJson)
      
            rCount = rCount + 1
          
            Cells(rCount, cCount) = m.SubMatches(0)
          
        Next
      
        rCount = 0
      
    Next      
  
End Sub

Cevabınız için teşekkürler ancak strJson kısmına string olarak ekledim hata verdi tüm satır kımızı oldu. link olarak eklediğimde işlem yapmadı.

 

[Haluk]

Sunucuya isteği gönderdikten sonra geri dönen cevabı "strJson" değişkenine atayacaksınız.

Forumda örnekler var ....

.

 

[veyselemre]

Sub test()
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://havuz-132ce.firebaseio.com/test.json"
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    al = Mid(objHTTP.responseText, 3)
    al = Replace(Replace(Left(al, Len(al) - 1), "},", "}"), "{", "")
    sat = 2
    Cells.ClearContents
    baslik = Array("PUSH ID", "SENDER", "MSG", "LOCAL TIME", "SERVER TIME")
    [a1].Resize(, 5).Value = baslik
    sat = 2
    For Each c In Split(al, "}")
        If c <> "" Then
            sut = 1
            bl = Split(Replace(Replace(c, ",", ":"), Chr(34), ""), ":")
            Cells(sat, sut) = bl(0)
            For i = 1 To 2
                Cells(sat, sut + i).Value = bl(i)
            Next i
            t = bl(4) & ":" & bl(5) & ":" & bl(6)
            b = Split(t, " ")
            bb = Split(b(0), "-")
            Cells(sat, 4).Value = bb(2) & "." & bb(1) & "." & bb(0) & " " & b(1)
            Cells(sat, 5).Value = (bl(8) / 1000 / 86400) + 25569
            Cells(sat, 5).NumberFormat = "dd/mm/yyyy hh:mm:ss;@"
            sat = sat + 1
        End If
    Next c
End Sub

 

[işsiz123]

Sunucuya isteği gönderdikten sonra geri dönen cevabı "strJson" değişkenine atayacaksınız.

Forumda örnekler var ....

.

Teşekürler

 

[işsiz123]

Sub test()
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://havuz-132ce.firebaseio.com/test.json"
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    al = Mid(objHTTP.responseText, 3)
    al = Replace(Replace(Left(al, Len(al) - 1), "},", "}"), "{", "")
    sat = 2
    Cells.ClearContents
    baslik = Array("PUSH ID", "SENDER", "MSG", "LOCAL TIME", "SERVER TIME")
    [a1].Resize(, 5).Value = baslik
    sat = 2
    For Each c In Split(al, "}")
        If c <> "" Then
            sut = 1
            bl = Split(Replace(Replace(c, ",", ":"), Chr(34), ""), ":")
            Cells(sat, sut) = bl(0)
            For i = 1 To 2
                Cells(sat, sut + i).Value = bl(i)
            Next i
            t = bl(4) & ":" & bl(5) & ":" & bl(6)
            b = Split(t, " ")
            bb = Split(b(0), "-")
            Cells(sat, 4).Value = bb(2) & "." & bb(1) & "." & bb(0) & " " & b(1)
            Cells(sat, 5).Value = (bl(8) / 1000 / 86400) + 25569
            Cells(sat, 5).NumberFormat = "dd/mm/yyyy hh:mm:ss;@"
            sat = sat + 1
        End If
    Next c
End Sub

Teşekkürler