有时为了收集资料,需要批量将一个网站的多个网页保存下来,有了这几个过程或函数,就可以自动的完成工作了。使用方法:在VBE里先插入一个标准模块,然后再将下面的代码粘贴进去就可以使用了,非常简单。
' 引用: Microsoft ActiveX Data Objects 2.5 Library
' 引用: Microsoft CDO for Windows 2000 Library (cdosys.dll)
Sub TestSaveAsMht()
UrlToMht "http://www.xf4hs.com/", "D:\Temp\1.mht"
SavePageToMHT "http://www.xf4hs.com/", "D:\Temp\abc.mht"
End Sub
Sub UrlToMht(URL As String, Mht As String)
Dim oCDOMessage As Object
Set oCDOMessage = CreateObject("CDO.Message")
With oCDOMessage
.MimeFormatted = True
.CreateMHTMLBody URL, 0, "", ""
.GetStream.SaveToFile Mht, 2
End With
Set oCDOMessage = Nothing
End Sub
Function SavePageToMHT(ByVal URL As String, ByVal FileName As String) As Boolean
Dim objMsg As Object
Set objMsg = CreateObject("CDO.Message")
Dim objStream As Object
Set objStream = CreateObject("ADODB.Stream")
On Error GoTo Err_Handle:
objMsg.CreateMHTMLBody URL, , "qwemini1", "qwemini1"
Set objStream = objMsg.GetStream
objStream.SaveToFile FileName, 2 'adSaveCreateOverWrite
SavePageToMHT = True
Sub_Handle:
Set objMsg = Nothing
Set objStream = Nothing
Exit Function
Err_Handle:
MsgBox "错误: " & Err.id & " 号。错误说明: " & Err.Description & "。", vbOKOnly, "系统错误"
SavePageToMHT = False
GoTo Sub_Handle:
End Function