CODEWITHSUNDEEP
htmlvb.netmhtml
Arash Hatami
Arash Hatami

Reputation: 5551

How modify VB.Net code for save webpages as mht automatically?

I have a simple VB.Net program for saving webpages as mht format
currently I'm using the following way:

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

My code work fine, but the save process is like a normal save page in a browser. Right-Click > Save page as ... and select a direction with a name for saving file

Is there a way that save operation to be performed automatically? without any popup windows, just give the program a direction and a file name in the code

for example :

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

this code didn't work and i have error Write to file failed. for the following code 

adodbstream.SaveToFile(FilePath, ADODB.SaveOptionsEnum.adSaveCreateOverWrite)

Upvotes: 0

Views: 1206

Answers (2)

Mysta
Mysta

Reputation: 79

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

Upvotes: 1

Mysta
Mysta

Reputation: 79

Try:

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

Upvotes: 0

Related Questions