
Sub All_3()
Dim objXML As Object
Dim i, j, k
Dim ar_data
Dim myStr, sp
Set objXML = CreateObject("MSXML2.ServerXMLHTTP")
Sheet6.Range("A2:L1048576").ClearContents
myStr = "http://64.push2.,m:0+t:13,m:0+t:80,m:1+t:2,m:1+t:23&fields=f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f12,f13,f14,f15,f16,f17,f18,f20,f21,f23,f24,f25,f22,f11,f62,f128,f136,f115,f152&_=1603443145439"
With objXML
.Open "GET", myStr, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "If-Modified-Since", "0"
.send
sp = .responseText
End With
sp = Split(sp, "f1" & Chr(34) & ":")
ReDim ar_data(1 To UBound(sp), 1 To 12)
For i = 1 To UBound(sp)
ar_data(i, 1) = Replace(Replace(Split(Split(sp(i), "f12")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 2) = Replace(Replace(Split(Split(sp(i), "f14")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 3) = Replace(Replace(Split(Split(sp(i), "f2")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 4) = Replace(Replace(Split(Split(sp(i), "f15")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 5) = Replace(Replace(Split(Split(sp(i), "f16")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 6) = Replace(Replace(Split(Split(sp(i), "f17")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 7) = Replace(Replace(Split(Split(sp(i), "f18")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 8) = Replace(Replace(Split(Split(sp(i), "f4")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 9) = Replace(Replace(Split(Split(sp(i), "f3")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 10) = Replace(Replace(Split(Split(sp(i), "f8")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 11) = Replace(Replace(Split(Split(sp(i), "f5")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 12) = Replace(Replace(Split(Split(sp(i), "f6")(1), ",")(0), Chr(34), ""), ":", "")
Next
Sheet6.Range("A2").Resize(UBound(ar_data), UBound(ar_data, 2)) = ar_data
ar_data = Sheet6.Range("A1").CurrentRegion
For j = 1 To UBound(ar_data)
i_row = ""
ar_data(j, 1) = Format(ar_data(j, 1), "000000")
For k = 1 To UBound(ar_data, 2)
i_row = i_row & vbTab & ar_data(j, k)
Next
i_col = i_col & vbNewLine & i_row
Next
Open ThisWorkbook.Path & "outfile.txt" For Output As #1
Print #1, i_col
Close #1
MsgBox "OK"
End Sub
Dim objXML As Object
Dim i, j, k
Dim ar_data
Dim myStr, sp
Set objXML = CreateObject("MSXML2.ServerXMLHTTP")
Sheet6.Range("A2:L1048576").ClearContents
myStr = "http://64.push2.,m:0+t:13,m:0+t:80,m:1+t:2,m:1+t:23&fields=f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f12,f13,f14,f15,f16,f17,f18,f20,f21,f23,f24,f25,f22,f11,f62,f128,f136,f115,f152&_=1603443145439"
With objXML
.Open "GET", myStr, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "If-Modified-Since", "0"
.send
sp = .responseText
End With
sp = Split(sp, "f1" & Chr(34) & ":")
ReDim ar_data(1 To UBound(sp), 1 To 12)
For i = 1 To UBound(sp)
ar_data(i, 1) = Replace(Replace(Split(Split(sp(i), "f12")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 2) = Replace(Replace(Split(Split(sp(i), "f14")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 3) = Replace(Replace(Split(Split(sp(i), "f2")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 4) = Replace(Replace(Split(Split(sp(i), "f15")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 5) = Replace(Replace(Split(Split(sp(i), "f16")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 6) = Replace(Replace(Split(Split(sp(i), "f17")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 7) = Replace(Replace(Split(Split(sp(i), "f18")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 8) = Replace(Replace(Split(Split(sp(i), "f4")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 9) = Replace(Replace(Split(Split(sp(i), "f3")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 10) = Replace(Replace(Split(Split(sp(i), "f8")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 11) = Replace(Replace(Split(Split(sp(i), "f5")(1), ",")(0), Chr(34), ""), ":", "")
ar_data(i, 12) = Replace(Replace(Split(Split(sp(i), "f6")(1), ",")(0), Chr(34), ""), ":", "")
Next
Sheet6.Range("A2").Resize(UBound(ar_data), UBound(ar_data, 2)) = ar_data
ar_data = Sheet6.Range("A1").CurrentRegion
For j = 1 To UBound(ar_data)
i_row = ""
ar_data(j, 1) = Format(ar_data(j, 1), "000000")
For k = 1 To UBound(ar_data, 2)
i_row = i_row & vbTab & ar_data(j, k)
Next
i_col = i_col & vbNewLine & i_row
Next
Open ThisWorkbook.Path & "outfile.txt" For Output As #1
Print #1, i_col
Close #1
MsgBox "OK"
End Sub
[local]1[/local]