1.網路抓取有很多種方法，處理也有很多種方法，以下提供一些程式碼，僅供參考

（1）GET獲取資料

Option Explicit
'以快遞一百查詢快遞單號為例
'用fiddler 來檢視自己想要的連結等資訊
'GET請求獲取資料
Public Sub testkuaidi()
    Dim xmlhttp As Object
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP") '建立XML物件
    xmlhttp.Open "GET", "http://www.kuaidi100.com/query?type=zhongtong&postid=217236429995", False  '用GET 傳送請求
    
    xmlhttp.Send
    '等待響應
    Do While xmlhttp.readyState <> 4
        DoEvents
    Loop
    '將結果打印出來
    Debug.Print xmlhttp.responsetext
End Sub
'防盜鏈處理
Public Sub testkuaidi2()
    Dim winhttp As Object
    Set winhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    winhttp.Open "GET", "http://www.kuaidi100.com/query?type=zhongtong&postid=217236429995", False  '&temp=0.978924173706677
    '如果網站有防盜處理（即必須要從該網站進入）則可以進行防盜鏈處理，也很簡單，在請求和傳送之間設定頭資訊
    winhttp.setrequestheader "Referer", "http://www.kuaidi100.com/" '設定請求的頭資訊
    winhttp.Send
    
    Debug.Print winhttp.responsetext
End Sub

 

（2）資料處理（json）

Option Explicit
'json 解析
Sub textjson()
    Const strjson As String = "[""甲"",""乙"",""丙""]"
    Dim objjson As Object
    Dim cell
    With CreateObject("msscriptcontrol.scriptcontrol")
        .Language = "JavaScript"
        .addcode "var mydata=" & strjson
        Set objjson = .codeobject
        
    End With
    Stop
    For Each cell In objjson.mydata
        Debug.Print cell
    Next
End Sub
Public Function testjson2(strjson As String)
    Dim objjson
    With CreateObject("msscriptcontrol.scriptcontrol")
    .Language = "JavaScript"
        .addcode "var mydata=" & strjson
        Set objjson = .codeobject
    End With
    Set testjson2 = objjson
End Function

Public Function test3()
    Dim objjson As Object
    Set objjson = testjson2("[{""name"":""er"",""age"":18},{""name"":""ur"",""age"":45}]")
    Dim objitem As Object
    For Each objitem In objjson.mydata
        Debug.Print CallByName(objitem, "name", VbGet)
        Debug.Print CallByName(objitem, "age", VbGet)
        Debug.Print
    Next
    
    
End Function


 

(3)POST方法獲取資料

'有道翻譯
Option Explicit
'用post方法來獲取資訊
Public Sub translate(str As String) '輸入字元則可以翻譯
    If str = "" Then Exit Sub
    Dim objxml As Object
    Set objxml = CreateObject("MSXML2.XmlHttp")
    objxml.Open "POST", "http://fanyi.youdao.com/translate", False
    objxml.setrequestheader "Content-Type", "application/x-www-from-urlencode;charset=UTF-8"
    objxml.Send "i=" & str & "&doctype=json" '指定
    Do While objxml.readyState <> 4
        DoEvents
    Loop
    Dim strresponse As String
    strresponse = objxml.responsetext
    Debug.Print strresponse
       Debug.Print Split(Split(strresponse, "tgt"":""")(1), """")(0)
End Sub
Public Sub test()
    Dim objxml As Object
    Set objxml = CreateObject("MSXML2.XMLHTTP")
    objxml.Open "POST", "http://fanyi.youdao.com/translate", False
    objxml.setrequestheader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
    objxml.Send "i=hello&doctype=json"
    Do While objxml.readyState <> 4
        DoEvents
    Loop
    Dim strresponse As String
    strresponse = objxml.responsetext
    Debug.Print strresponse
   Debug.Print Split(Split(strresponse, "tgt"":""")(1), """")(0)
End Sub