Sub 淘寶關鍵字搜尋_V1_20180915_2()

    Dim objhttp As Object

    Set objhttp = CreateObject("MSXML2.xmlhttp.3.0")
   
    Sheets("淘寶").Select
   
    myjobtype = Cells(3, "B").Value
    Tdate = Format(VBA.Date, "yyyymmdd")
    If myjobtype = "" Then
        MsgBox "請輸入搜尋關鍵字!!!!不可空白..................kim提醒。"
        Exit Sub
    End If
   
    Application.ScreenUpdating = False      '畫面更新關閉
    URL = "https://s.taobao.com/search?q=%E5%AF%B5%E7%89%A9&type=p&tmhkh5=&spm=a21wu.241046-tw.a2227oh.d100&from=sea_1_searchbutton&catId=100"
   
    objhttp.Open "GET", URL, 1
    objhttp.send

    While objhttp.readyState <> 4: DoEvents: Wend

    Sheets("下載").Select
   
    ROW3 = Cells(Rows.Count, 1).End(3).Row
    Range(Cells(1, 1), Cells(ROW3, 3)).Clear
   
    Cells(1, 1) = objhttp.responseText
    S = objhttp.responseText

    iStart = 1
    i = 2
   
    Do While VBA.InStr(iStart, S, "item_loc") <> 0
        
        iStart = VBA.InStr(iStart, S, "raw_title")
        iEnd = VBA.InStr(iStart, S, ",")
        Cells(i, "A") = Mid(S, iStart + 12, iEnd - iStart - 13)
        iStart = iEnd + 12
   
   
        iStart = VBA.InStr(iStart, S, "item_loc")
        iEnd = VBA.InStr(iStart, S, ",")
        Cells(i, "B") = Mid(S, iStart + 11, iEnd - iStart - 12)
        iStart = iEnd + 11
        
        iStart = VBA.InStr(iStart, S, "nick")
        iEnd = VBA.InStr(iStart, S, ",")
        Cells(i, "C") = Mid(S, iStart + 7, iEnd - iStart - 8)
        iStart = iEnd + 7
        
        i = i + 1
   
    Loop

      

End Sub