如何自动修改VB.Net代码以保存网页?

时间:2016-01-04 19:20:42

标签: html vb.net mhtml

我有一个简单的VB.Net程序,用于将网页保存为mht格式
目前我正在使用以下方式:

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    WebBrowser1.Navigate("http://www.google.com")
End Sub

Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
    Dim SaveFileDialog1 As New SaveFileDialog()
    SaveFileDialog1.Filter = "mht files (*.mht)|*.mht|All files (*.*)|*.*"
    If SaveFileDialog1.ShowDialog() = DialogResult.OK Then
        fileNamePath = SaveFileDialog1.FileName
        SavePage(WebBrowser1.Url.ToString, fileNamePath)
    End If
End Sub

Private Sub SavePage(ByVal Url As String, ByVal FilePath As String)
    Dim iMessage As CDO.Message = New CDO.Message
    iMessage.CreateMHTMLBody(Url, CDO.CdoMHTMLFlags.cdoSuppressObjects, "", "")
    Dim adodbstream As ADODB.Stream = New ADODB.Stream
    adodbstream.Type = ADODB.StreamTypeEnum.adTypeText
    adodbstream.Charset = "UTF-8"
    adodbstream.Open()
    iMessage.DataSource.SaveToObject(adodbstream, "_Stream")
    adodbstream.SaveToFile(FilePath, ADODB.SaveOptionsEnum.adSaveCreateOverWrite)
End Sub

我的代码工作正常,但保存过程就像浏览器中的普通保存页面。 右键单击>将页面另存为...并选择具有保存文件名称的方向

有没有一种方法可以自动执行保存操作?没有任何弹出窗口,只需在程序中为程序指定方向和文件名

例如:

 SavePage("http://google.com", "C:\google.mht")

此代码无效,我对以下代码

有错误Write to file failed.
adodbstream.SaveToFile(FilePath, ADODB.SaveOptionsEnum.adSaveCreateOverWrite)

2 个答案:

答案 0 :(得分:0)

尝试:

adodbstream.SaveToFile(FilePath & "Filename.mht", ADODB.SaveOptionsEnum.adSaveCreateOverWrite)

答案 1 :(得分:0)

Imports ADODB
Imports CDO
Public Class Form1
    Dim fileNamePath = "C:\"

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button1.Click
        WebBrowser1.Navigate(TextBox1.Text)
    End Sub

    Private Sub SavePage(ByVal Url As String, ByVal FilePath As String)
        Try
            Dim iMessage As CDO.Message = New CDO.Message
            iMessage.CreateMHTMLBody(Url, CDO.CdoMHTMLFlags.cdoSuppressObjects, "", "")
            Dim adodbstream As ADODB.Stream = New ADODB.Stream
            adodbstream.Type = ADODB.StreamTypeEnum.adTypeText
            adodbstream.Charset = "UTF-8"
            adodbstream.Open()
            iMessage.DataSource.SaveToObject(adodbstream, "_Stream")
            adodbstream.SaveToFile(FilePath & CheckAndClean(TextBox1.Text) & ".mht", ADODB.SaveOptionsEnum.adSaveCreateOverWrite)

        Catch ex As Exception

        End Try
           End Sub
    Private Function CheckAndClean(ByVal StringToCheck As String) As String
        Dim sIllegal As String = "\,/,:,*,?," & Chr(34) & ",<,>,|"
        Dim arIllegal() As String = Split(sIllegal, ",")
        Dim sReturn As String
        sReturn = StringToCheck
        For i = 0 To arIllegal.Length - 1
            sReturn = Replace(sReturn, arIllegal(i), "")
        Next
        Return sReturn
    End Function
    Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
        SavePage(TextBox1.Text, fileNamePath)
    End Sub