VB 如何保存整个网页的内容？

当用腾讯浏览器看网页时，点击“文件-另存为：单个文件（*.mht）”，可以把整个网页保存下来。在没上网的时候，可以脱机浏览。请教各位大侠，这一功能如何用VB编程来实现？
我用的代码是：
'引用Microsoft CDO for Windows 2000 Library和microsoft activeX data objects 2.8 library
Private Sub Command1_Click()
    Dim a As New CDO.Message
    Dim b As ADODB.Stream
    a.CreateMHTMLBody "http://www.****.com", cdoSuppressAll, "", ""
    Set b = a.GetStream
    b.SaveToFile "c:\1.mht" '保存到C盘,生成1.mht文件
    MsgBox "OK"
End Sub但它生成的mht文件并不能完全把网页的内容存下来。希望大侠能给出一段完整可行的代码，急急急。

解决方案 »

  1.   

    是的，用此代码，经常就有一些图片看不到。但是腾讯浏览器的另存为：单个文件（*.mht），能完整的把网页保存下来，脱机浏览没问题。所以，我想用VB来实现与它一样的功能。
      

  2.   

    研究过.mht文件，没有成功，可以查阅的资料也少得可怜。
      

  3.   

    这个是否有用
    引用
    Private Sub SavePicture(szURL, fName)           '保存图片
        '网页路径，文件名
        Dim x As XMLHTTP
        Dim oStream As ADODB.Stream
        Dim xx As String
        
        Set x = New XMLHTTP
        x.Open "GET", szURL, False
        x.send
        xx = App.Path + "\"
        Set oStream = New ADODB.Stream
        oStream.Type = 1
        oStream.Open
        oStream.Write x.responseBody
        oStream.SaveToFile xx + fName
        oStream.Close
    End Sub'********************************************************************'  简单实现
    Private Sub Command1_Click()
        Call SavePicture("http://forum.csdn.net/PointForum/ui/scripts/csdn/Plugin/003/monkey/2.gif", "abc.gif")End Sub
      

  4.   


    Sub getWeb()    Dim X As XMLHTTP
        tmpth = "c:\temp.htm"
        URL = "http://www.baidu.com/"
        Set X = New XMLHTTP
        X.Open "GET", URL, False
        X.send
        s = X.responseText
        ss = "<body>"
        arr = Split(s, ss)
        ss = ss & arr(1)
        If Dir(tmpth) <> "" Then Kill tmpth    Open tmpth For Output As 1
        Print #1, , ss
        Close 1
        WebBrowser1.Navigate2 tmpth
        Set bd = WebBrowser1.Document.body
        Do While bd Is Nothing
            DoEvents
            Set bd = WebBrowser1.Document.body
        Loop
        SendKeys "c:\baidu.htm"
        SendKeys "{ENTER}"
        WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER
        Kill tmpth
    End Sub
      

  5.   

    Private    Sub   SavePicture(szURL,   fName)    '保存图片       
              '网页路径，文件名       
              Dim   x   As   XMLHTTP       
              Dim   oStream   As   ADODB.Stream       
              Dim   xx   As   String       
                    
              Set   x   =   New   XMLHTTP       
              x.Open   "GET",   szURL,   False       
              x.send       
              xx   =   app.path   +   "/"       
                    Set   oStream   =   New   ADODB.Stream       
                    oStream.Type   =   1       
                    oStream.Open       
                    oStream.Write   x.responseBody       
                    oStream.SaveToFile   xx   +   fName       
                    oStream.Close       
      End   Sub       
            
     ' 简单实现       
            
      call   SavePicture("http://expert.csdn.net/images/csdn.gif";,"abc.gif")   '功能：取得网址中的所有链接名称和地址    
    '需要要引用 Microsoft   HTML   Object   Library        
            
      Private   Sub   GetLinks()       
      Dim   Doc   As   IHTMLDocument2       
      Dim   All   As   IHTMLElementCollection       
      Dim   L   As   Integer       
      Dim   i   As   Integer       
      Dim   Varl   As   Variant       
            
      Set   Doc   =   WebBrowser1.document       
      Set   All   =    Doc.images   '取图片的连接      doc.links   取文字链接       
      L   =   All.length       
      For   i   =   0   To   L   -   1       
            Set   Varl   =   All.Item(i,   varempty)       
              List1.AddItem    ("地址："   &   Varl.href)    'item.innertext   取文本链接名称        
            Set   Varl   =   Nothing       
      Next   i       
      Set   All   =   Nothing       
      Set   Doc   =   Nothing       
      End   Sub   
       
    '然后在查找JPG,BMP等图片文件 
      

  6.   

    http://topic.csdn.net/u/20090901/20/ccf6a98d-258d-4040-b749-c4fb9f68b39c.html?18852
      

  7.   

    参数 cdoSuppressAll 改用 cdoSuppressNone
      

  8.   

    为了通用,修改一下ss = "<body>",修改成ss = "<body"
    Sub getWeb()    Dim X As XMLHTTP
        tmpth = "c:\temp.htm"
        URL = "http://www.baidu.com/"
        Set X = New XMLHTTP
        X.Open "GET", URL, False
        X.send
        s = X.responseText
        ss = "<body"
        arr = Split(s, ss)
        ss = ss & arr(1)
        If Dir(tmpth) <> "" Then Kill tmpth    Open tmpth For Output As 1
        Print #1, , ss
        Close 1
        WebBrowser1.Navigate2 tmpth
        Set bd = WebBrowser1.Document.body
        Do While bd Is Nothing
            DoEvents
            Set bd = WebBrowser1.Document.body
        Loop
        SendKeys "c:\baidu.htm"
        SendKeys "{ENTER}"
        WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER
        Kill tmpth
    End Sub
      

  9.   

    “Tiger_Zhao:参数 cdoSuppressAll 改用 cdoSuppressNone”。确实可行。缺点：有些网页无法保存，比如：www.sina.com，http://community.csdn.net/。优点：大多数网页还是可以保存的，可以保存的网页，能完全按网页的原来面貌保存;只生成一个.mht文件。chinaboyzyq的方法，缺点：有些网页无法保存;保存的网页格式改变，有点乱;要生成一个.htm文件和一个文件夹。lyserver的思路和jhone99的思路应该是一致的。谢谢。也非常感谢king06提供的链接。