Function GetURL(url) '訪問網頁的函式
With CreateObject("Msxml2.XMLHTTP") '創建xmlhttp用于讀取網頁源代碼
.Open "GET", url, False '獲取對應頁源代碼
.Send '發送請求
GetURL = .responseText '提取回傳的網頁源代碼
End With
End Function
Sub TBXH()
K = 2
Set MyS = ActiveWorkbook.ActiveSheet
tb = MyS.Cells(K, "J").Value
Do While tb <> ""
url = "http://rate.taobao.com/user-rate-" & tb & ".htm"
HTM_data = GetURL(url)
Set RegEx = CreateObject("vbscript.regexp") '創建正則運算式
With RegEx
.Global = True '全域有效
.MultiLine = True '多行有效
.ignorecase = True '忽略大小寫(網頁處理時這個引數比較重要)
.Pattern = "javascript:void\(0\)""\>(\d+)\</a\>" '匹配總信譽點數
If .test(HTM_data) Then '如果可以匹配到結果,則
T = Val(.Execute(HTM_data)(0).submatches(0)) '提取信譽點數
End If
.Pattern = "\&result\=1\'\>(\d+)\</a\>" '匹配周、月信譽點數
If .test(HTM_data) Then '如果可以匹配到結果,則
T7 = Val(.Execute(HTM_data)(0).submatches(0)) '提取周信譽點數
T30 = Val(.Execute(HTM_data)(1).submatches(0)) '提取月信譽點數
End If
End With
MyS.Cells(K, "S").Value = T - MyS.Cells(K, "L").Value
MyS.Cells(K, "L").Value = T
MyS.Cells(K, "M").Value = T7
MyS.Cells(K, "N").Value = T30
K = K + 1
tb = MyS.Cells(K, "J")
Loop
MsgBox ("成功更新" + Str(K - 1) + "個小號信譽情況！")
End Sub
各位大神，是什么原因，先前這宏的編輯內容點更新信譽時候都會有詳細點數，為什么現在點更新信譽就全變成0了啊？
uj5u.com熱心網友回復：
http://rate.taobao.com/myRate.htm?spm=a1z02.1.a2109.d1000377.R6ffEe 網頁源是淘寶的評價管理uj5u.com熱心網友回復：
估計你獲取網頁原始碼就有問題吧。 淘寶很多資料都是通過Ajax加載的。 你通過組件下載得到的就是個空殼子框架而已。轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/102492.html
標籤：VBA
上一篇：用vb給百度貼吧發帖