我在網上找到使用rft控件保存webbrowse文本 txtHtml是RichTextBox
txtHTML.Text = WebBrowser1.document.body.innerText
´flag ：rsftext 保存為txt文件，strtmp文件路徑
txtHTML.saveFile strtmp, rtfText
將其name屬性設置為web
Private Sub Command1_Click()
web.Navigate ""
End Sub
Private Sub web_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Set doc = web.Document
For Each i In doc.All
msgbox typename(i)
Text1.Text = Text1.text & vbclrf & i.innertext
Next
End sub
===========================================================================================
轉載
´引用 Microsoft HTML Object Library
Dim oDoc As HTMLDocument
Dim oElement As Object
Dim oTxtRgn As Object
Dim sSelectedText As String
Set oDoc = WebBrowser1.Document´獲得文檔對象
Set oElement = oDoc.getElementById("T1")´獲得ID="T1"的對象
Set oTxtRgn = oDoc.selection.createRange´獲得文檔當前正選擇的區域對象
sSelectedText = oTxtRgn.Text´選擇區域文本賦值
oElement.Focus´"T1"對象獲得焦點
oElement.Select´全選對象"T1"
Debug.Print "你選擇了文本：" & sSelectedText
上麵這段兒還附送了其他功能，嗬嗬。精簡一下是這樣：
Dim oDoc As Object
Dim oTxtRgn As Object
Dim sSelectedHTML As String
Set oDoc = WebBrowser1.Document ´獲得文檔對象
Set oTxtRgn = oDoc.selection.createRange ´獲得文檔當前正選擇的區域對象
sSelectedHTML = oTxtRgn.htmlText ´選擇區域文本賦值
Text1.Text=sSelectedHTML ´文本框顯示抓取得HTML源碼
......´或者繼續分析源碼
==================================================================================================
我用WebBrowser取得網頁源碼，直接運行正常，但在編譯後出錯
Private Sub Command1_Click()
WebBrowser1.Navigate ""
End Sub
Private Sub WebBrowser1_DownloadComplete()
´頁麵下載完畢
Dim doc, objhtml
Set doc = WebBrowser1.Document
Set objhtml = doc.body.createtextrange()
If Not IsNull(objhtml) Then
Text1.Text = objhtml.htmltext
End If
End Sub
我用WebBrowser取得網頁源碼，直接運行正常，但在編譯後出錯
提示：實時錯誤“91” Object 變量或 with 塊變量沒有設置
可能是沒有下載完所致，
Private Sub WebBrowser1_DownloadComplete()
if webbrowser.busy=false then
Dim doc, objhtml
Set doc = WebBrowser1.Document
Set objhtml = doc.body.createtextrange()
If Not IsNull(objhtml) Then
Text1.Text = objhtml.htmltext
End If
end if
End Sub
你要得網頁源碼用 xmlhttp比較好
先引用 msxml
Dim x As New MSXML2.XMLHTTP
x.open "get", "", False
x.send
MsgBox StrConv(x.responseBody, vbUnicode)
===============================================================================================
我在網上找到使用rft控件保存webbrowse文本 txtHtml是RichTextBox
txtHTML.Text = WebBrowser1.document.body.innerText
´flag ：rsftext 保存為txt文件，strtmp文件路徑
txtHTML.saveFile strtmp, rtfText
=====================================================================================
Private Sub WebBrowser1_DownloadComplete()
Dim objHtml As Object
´下載完成時狀態欄顯示“Link Finished”
Set objHtml = Me.WebBrowser1.Document.Body.Createtextrange()
If Not IsNull(objHtml) Then
Text1.Text = objHtml.htmltext
End If
End Sub
使用inet控件
Source1 = Inet1.OpenURL("")
If Source1 <> "" Then
RichTextBox1.Text = Source1
Me.Inet1.Cancel
Else
Source = MsgBox("Source code is not available.", vbInformation, "Source Code")
End If
Private Sub Command1_Click()
Text1.Text = WebBrowser1.Document.body.innerHTML
End Sub
==================================================================================
加入timer,commandbutton,text
private sub command1_click()
webbrowser1.navigate
timer1.enabled=true
end sub
private sub timer1_timer()
dim doc,objhtml as object
dim i as integer
dim strhtml as string
if not webbrowser1.busy then
set doc=webbrowser1.document
i=0
set objhtml=doc.body.createtextrange()
if not isnull(objhtml) then
text1.text=objhtml.htmltext
end if
timer1.enabled=false
end if
end sub
Dim doc, objhtml As Object
If Not webbrowser1.Busy Then
Set doc = webbrowser1.Document
Set objhtml = doc.body.createtextrange()
If Not IsNull(objhtml) Then
text1.text=objhtml.htmltext
End If
Set doc = Nothing
Set objhtml = Nothing
End If
===================================================================================================
或者試試用InternetReadFile，效果也可以：
Option Explicit
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
ByVal sAgent As String, ByVal lAclearcase/" target="_blank" >ccessType As Long, _
ByVal sProxyName As String, ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" ( _
ByVal hInternetSession As Long, ByVal sUrl As String, _
ByVal sHeaders As String, ByVal lHeadersLength As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" ( _
ByVal hFile As Long, ByVal sBuffer As String, _
ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
ByVal hInet As Long) As Integer
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Dim s
Private Function GetUrlFile(stUrl As String) As String
Dim lgInternet As Long, lgSession As Long
Dim stBuf As String * 1024
Dim inRes As Integer
Dim lgRet As Long
Dim stTotal As String
stTotal = vbNullString
lgSession = InternetOpen("VBTagEdit", 1, vbNullString, vbNullString, 0)
If lgSession Then
lgInternet = InternetOpenUrl(lgSession, stUrl, vbNullString, _
0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
If lgInternet Then
Do
inRes = InternetReadFile(lgInternet, stBuf, 1024, lgRet)
stTotal = stTotal & Mid$(stBuf, 1, lgRet)
Loop While (lgRet <> 0)
End If
inRes = InternetCloseHandle(lgInternet)
End If
GetUrlFile = stTotal
End Function
Private Sub Command1_Click()
Text1.Text = GetUrlFile("")
End Sub
=====================================================================================================
Set vDoc = WebBrowser1.Document
´獲取網頁的源碼
For Each o In vDoc.All
DoEvents
htmlpage = htmlpage & o.innerHTML
Next
然後用寫二進製文件的方法將htmlpage的內容寫入到.html文件中如果這個網頁中含有框架那麼要對框加進行處理。
————————————————
版權聲明：本文為CSDN博主「ncgege」的原創文章，遵循 CC 4.0 BY-SA 版權協議，轉載請附上原文出處鏈接及本聲明。
原文鏈接：https://blog.csdn.net/esonbest1234/article/details/50729089
本文版权：
http://www.ndfweb.cn/news-735.html
