WebBrowser多次跳转页面的问题 - Office中国论坛/Access中国论坛

Option Compare Database
Option Explicit
'这一句是延时执行，但是没用
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
Dim rst As New ADODB.Recordset
Dim i As Long
Dim k As String
Dim s As Double
rst.Open "tblID", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To rst.RecordCount
s = GetData(rst(1))
rst(2) = s
rst.update
MsgBox s '如果加上这句写入的值就是正确的，如果不加入，写入的值永远都是第一个。
rst.MoveNext
'Sleep 1000
Next i
rst.Close
End Sub
Private Sub Form_Load()
Dim wb As WebBrowser
Set wb = Me.WebBrowser0.Object
wb.Navigate "http://detail.tmall.com/item.htm?_u=n1sscq85e5e0&id=40336681573#J_Reviews"
t = Timer
End Sub
Function GetData(strID As String)
Dim wb As WebBrowser
Dim doc As HTMLDocument
Dim a_tags As IHTMLElementCollection
Dim a_tag As IHTMLElement
Dim str As String
Set wb = Me.WebBrowser0.Object
wb.Navigate "http://detail.tmall.com/item.htm?_u=n1sscq85e5e0&id=" & strID & "#J_Reviews"
Set doc = wb.Document
Set a_tags = doc.all.tags("div")
For Each a_tag In a_tags
If a_tag.className = "rate-score" Then
str = Mid(a_tag.innerText, InStr(1, a_tag.innerText, "符") + 1)
End If
Next
GetData = str
End Function

复制代码

Function GetData(strID As String)
Dim wb As WebBrowser
Dim doc As HTMLDocument
Dim a_tags As IHTMLElementCollection
Dim a_tag As IHTMLElement
Dim str As String
Set wb = Me.WebBrowser0.Object
'加上这几句试试？
'***************
Do Until wb.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
'*******************
wb.Navigate "http://detail.tmall.com/item.htm?_u=n1sscq85e5e0&id=" & strID & "#J_Reviews"
Set doc = wb.Document
Set a_tags = doc.all.tags("div")
For Each a_tag In a_tags
If a_tag.className = "rate-score" Then
str = Mid(a_tag.innerText, InStr(1, a_tag.innerText, "符") + 1)
End If
Next
GetData = str
End Function

复制代码