Public Function GetPage(url)
Dim Retrieval
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", url, False
.Send
GetPage = BytesToBstr(.ResponseBody)
End With
Set Retrieval = Nothing
End Function

Public Function BytesToBstr(body)
Dim objstream
Set objstream = CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode = 3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = "UTF-8"
BytesToBstr = objstream.ReadText
objstream.Close
Set objstream = Nothing
End Function

Private Sub Command1_Click()
On Error Resume Next
Dim Num As String, time As String, Status As String, sRes As String
'Num = Text1.Text
Num = "78161096634176"
url = "https://api. & Num
Dim iTimeOut As Integer
Dim iTimeOutMax As Integer
Dim aFile As Variant

Dim arrLine As Variant
Dim sLine As String '每行跟踪记录

Dim arrText As Variant
Dim sText As String '在每行跟踪记录中用于分段获取时间和日志

Dim iCnt As Integer

aFile = Split(GetPage(url), """list"":[{")
If UBound(aFile) >= 1 Then

sLine = aFile(1)
arrLine = Split(sLine, "},{")
For iCnt = 0 To UBound(arrLine)
sText = arrLine(iCnt)
arrText = Split(sText, """:""")
If UBound(arrText) >= 2 Then
time = arrText(1)
Status = arrText(2)
time = Rep(time)
Status = Rep(Status)




End If

Next

Text2.Text = "" & Status & vbCrLf & Space(1) & time

sRes = aFile(0)

End If


End Sub
'替换掉无用的字符串
Function Rep(str As String) As String
Dim sRes As String
sRes = Replace(str, """", "")
sRes = Replace(sRes, "{", "")
sRes = Replace(sRes, "}", "")
sRes = Replace(sRes, ",status", "")
sRes = Replace(sRes, ",time", "")
sRes = Replace(sRes, ",deliverystatus", "")
sRes = Replace(sRes, ",issign", "")
sRes = Replace(sRes, "]:0:1", "")
sRes = Replace(sRes, "]:1:1", "")
sRes = Replace(sRes, "]:2:1", "")
sRes = Replace(sRes, "]:3:1", "")
sRes = Replace(sRes, "]:4:1", "")
Rep = sRes
End Function



如何把数组中的Status 和 time  都提取到text2.text 中，这样只能提取最后一条记录

写大概一个思路。
用instr从1开始找"status": " 并记录位置a，找到后从下一个字开始找"}，并记录位置b，然后用mid(str,a,b-a)提取内容文字midstr，
之后保存到数组或者text1.text=midstr+text1.text

手头只有vS2015

Function getText(str As String) As String
        Dim s, search1, search2, res As String
        Dim ls1, ls2, index1, index2 As Integer

        search1 = "'status':'"
        search2 = "'}"
        ls1 = Len(search1)
        ls2 = Len(search2)
        res = ""

        While (1)

            index1 = InStr(1, str, search1)
            If (index1 = 0) Then Exit While
            index1 += ls1
            index2 = InStr(index1, str, search2)
            If (index2 = 0) Then Exit While

            s = Mid(str, index1, index2 - index1)
            str = Mid(str, index2 + ls2)
            res = s + vbCrLf + vbCrLf + res

        End While


        getText = res

    End Function

[此贴子已经被作者于2020-12-2 13:12编辑过]