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

Question

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)

Answer 1

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

Answer 2

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