求:vb6,一个webbrowser怎么(用循环语句)打开多个网页?

时间:2023-01-03 23:17:13
我想实现自动拷贝一个论坛里的精华帖,它帖子页有很多,但网址是很有规律的比如"http://bbs.fobshanghai.com/viewthread.php?tid=3268999&extra=&page=1"(改一下最末位的那个page= 中的数字就是不同的帖子页的网址)

比如有20页,我试图用循环语句 
for i= 1 to 20
WebBrowser2.Navigate "http://bbs.fobshanghai.com/viewthread.php?tid=3268999&extra=&page=" & i

让webbrowser2循环打开这些帖子页然后用  Document.Body.InnerText将它复制出来

但我试了下不行,webbrowser并没有给我循环打开网页,而是好像直接给我打开最后一页就完事了. webbrowser要怎么样才能打开多个网页呢?多谢!!
----------------------------------------
Private Sub Form_Load()
Text5 = "http://bbs.fobshanghai.com/viewthread.php?tid=3268999&extra=&page="
Text4 = 20

WebBrowser1.Silent = True 
WebBrowser1.Navigate "http://bbs.fobshanghai.com/logging.php?action=login"
End Sub

Private Sub WebBrowser1_DownloadComplete()'先登录论坛,登录完毕再打开帖子

Dim ie
Set ie = WebBrowser1.Document
On Error Resume Next
ie.getElementById("username").Value = "11111111111111111111111"
On Error Resume Next
ie.getElementById("password").Value = "111111111111111111111111"
On Error Resume Next
ie.getElementById("loginsubmit").Click

Dim i As Integer
For i = 1 To Text4 '首页到末页
WebBrowser2.Navigate Text5 & i 'text5为帖子网址去掉最后一个数字,如"http://bbs.fobshanghai.com/viewthread.php?tid=3268999&extra=&page=6"
Text1 = WebBrowser2.Document.Body.InnerText & text1

next i
end sub
--------------------------
多谢!!


9 个解决方案

#1


刚试了下inet也不行,都不会循环.要怎么才能循环呢?
----------------------------------
For i = 1 To 20 '首页到末页
Inet1.Protocol = icHTTP
Text2 = Inet1.OpenURL("http://bbs.fobshanghai.com/viewthread.php?tid=3268999&extra=&page=" & i) & Text2
Next i

#2


网页载入是需要时间的 你最好搞个不独占的长循环等待下

#3


For i = 1 To 50
    URL = "http://148.36.19.209:81/exam/ExamPaperByStep.aspx?paper_id=173&mark_id=62227&ptype=0&Str_XuHao=" & i
    strData = getHtmlStr(URL)
    Set reg = CreateObject("vbscript.regExp")
    reg.Global = True
    reg.IgnoreCase = True
    reg.MultiLine = True
    reg.Pattern = "(?:<.*?>|&nbsp;)"

    Print #1, reg.Replace(strData, "")
Next

Public Function getHtmlStr(ByVal strUrl As String) As String
    Dim XmlHttp As Object
    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
    
    XmlHttp.Open "GET", strUrl, False
    On Error GoTo Err_net
    XmlHttp.send
    
    getHtmlStr = BytesToBstr(XmlHttp.ResponseBody, "UTF-8")
    
    Set XmlHttp = Nothing
Err_net:
End Function


Private Function BytesToBstr(strBody, codeBase) As String
    Dim objStream As Object
    Set objStream = CreateObject("Adodb.Stream")
    objStream.Type = 1
    objStream.Mode = 3
    objStream.Open
    objStream.Write strBody
    objStream.position = 0
    objStream.Type = 2
    objStream.Charset = codeBase
    BytesToBstr = objStream.ReadText
    objStream.Close
    Set objStream = Nothing
End Function
看下我的这个贴子http://topic.csdn.net/u/20110302/20/c0bc8f64-0be6-4b48-9818-620050086303.html

#4


引用 3 楼 zydscaline 的回复:
VB code
For i = 1 To 50
    URL = "http://148.36.19.209:81/exam/ExamPaperByStep.aspx?paper_id=173&amp;mark_id=62227&amp;ptype=0&amp;Str_XuHao=" &amp; i
    strData = getHtmlStr(URL)
    Set reg = ……

感谢!!
大侠你那个帖子打不开,打开是搜狗的一个搜索页面,能再发下吗?

#5


把URL换成你的不就完了么?一点不会的话就别做了

#6


引用 5 楼 dbcontrols 的回复:
把URL换成你的不就完了么?一点不会的话就别做了

不是,我说的不是代码里面的url,  是楼上zydscaline大侠留在帖子最末一句的那个:"看下我的这个贴子http://topic.csdn.net/u/20110302/20/c0bc8f64-0be6-4b48-9818-620050086303.html" 这个链接!!!!!!!

#7


引用 6 楼 jiutiwen 的回复:
引用 5 楼 dbcontrols 的回复:
把URL换成你的不就完了么?一点不会的话就别做了

不是,我说的不是代码里面的url, 是楼上zydscaline大侠留在帖子最末一句的那个:"看下我的这个贴子http://topic.csdn.net/u/20110302/20/c0bc8f64-0be6-4b48-9818-620050086303.html" 这个链接!!!!!!!
不看也罢,那是我求助别人让写个正则的

#8


LZ解决了没?

#9


很简单,加个判断网页加载完成,才可以循环。

#1


刚试了下inet也不行,都不会循环.要怎么才能循环呢?
----------------------------------
For i = 1 To 20 '首页到末页
Inet1.Protocol = icHTTP
Text2 = Inet1.OpenURL("http://bbs.fobshanghai.com/viewthread.php?tid=3268999&extra=&page=" & i) & Text2
Next i

#2


网页载入是需要时间的 你最好搞个不独占的长循环等待下

#3


For i = 1 To 50
    URL = "http://148.36.19.209:81/exam/ExamPaperByStep.aspx?paper_id=173&mark_id=62227&ptype=0&Str_XuHao=" & i
    strData = getHtmlStr(URL)
    Set reg = CreateObject("vbscript.regExp")
    reg.Global = True
    reg.IgnoreCase = True
    reg.MultiLine = True
    reg.Pattern = "(?:<.*?>|&nbsp;)"

    Print #1, reg.Replace(strData, "")
Next

Public Function getHtmlStr(ByVal strUrl As String) As String
    Dim XmlHttp As Object
    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
    
    XmlHttp.Open "GET", strUrl, False
    On Error GoTo Err_net
    XmlHttp.send
    
    getHtmlStr = BytesToBstr(XmlHttp.ResponseBody, "UTF-8")
    
    Set XmlHttp = Nothing
Err_net:
End Function


Private Function BytesToBstr(strBody, codeBase) As String
    Dim objStream As Object
    Set objStream = CreateObject("Adodb.Stream")
    objStream.Type = 1
    objStream.Mode = 3
    objStream.Open
    objStream.Write strBody
    objStream.position = 0
    objStream.Type = 2
    objStream.Charset = codeBase
    BytesToBstr = objStream.ReadText
    objStream.Close
    Set objStream = Nothing
End Function
看下我的这个贴子http://topic.csdn.net/u/20110302/20/c0bc8f64-0be6-4b48-9818-620050086303.html

#4


引用 3 楼 zydscaline 的回复:
VB code
For i = 1 To 50
    URL = "http://148.36.19.209:81/exam/ExamPaperByStep.aspx?paper_id=173&amp;mark_id=62227&amp;ptype=0&amp;Str_XuHao=" &amp; i
    strData = getHtmlStr(URL)
    Set reg = ……

感谢!!
大侠你那个帖子打不开,打开是搜狗的一个搜索页面,能再发下吗?

#5


把URL换成你的不就完了么?一点不会的话就别做了

#6


引用 5 楼 dbcontrols 的回复:
把URL换成你的不就完了么?一点不会的话就别做了

不是,我说的不是代码里面的url,  是楼上zydscaline大侠留在帖子最末一句的那个:"看下我的这个贴子http://topic.csdn.net/u/20110302/20/c0bc8f64-0be6-4b48-9818-620050086303.html" 这个链接!!!!!!!

#7


引用 6 楼 jiutiwen 的回复:
引用 5 楼 dbcontrols 的回复:
把URL换成你的不就完了么?一点不会的话就别做了

不是,我说的不是代码里面的url, 是楼上zydscaline大侠留在帖子最末一句的那个:"看下我的这个贴子http://topic.csdn.net/u/20110302/20/c0bc8f64-0be6-4b48-9818-620050086303.html" 这个链接!!!!!!!
不看也罢,那是我求助别人让写个正则的

#8


LZ解决了没?

#9


很简单,加个判断网页加载完成,才可以循环。