'Code generated by Marcelo Boczko
' Date: 2010/01/06
' This code saves Webpage (.html file) and pictures. Pay attention to path of the files
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Sub CommandButton1_Click()
If TextBox2.Text <> "" Then
Call SaveWebPage(TextBox1, TextBox2) 'passing Path and Archive name
End If
End Sub
Private Sub SaveWebPage(sURLPath As String, sURLArchive As String)
'Saving text information (.html file)
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
Label2.Caption = "Loading WebPage... ( " & sURLArchive & " )"
'WebBrowser1 is a WebBrowser control, enabled when some Tools/References are enabled:
' - Microsoft HTML Object Library
' - Microsoft Internet Controls
'Include WebBrower1 at your form
WebBrowser1.navigate (sURLPath & "/" & sURLArchive)
Dim e As IHTMLElement
Dim txtTemp As String
Dim iAux1 As Integer, iAux2 As Integer
Open ThisWorkbook.Path & "/" & sURLArchive For Output As #1
'Waiting till webpage loaded
Start = Now()
Do
DoEvents
Loop While WebBrowser1.readyState <> READYSTATE_COMPLETE
Label2.Caption = "Saving Text"
'Saving text
For Each e In WebBrowser1.document.All
If e.innerHTML <> "" Then 'Any condition to choose which part of the page to save
txtTemp = e.innerHTML
Print #1, txtTemp
Exit For
End If
Next
Close #1
'Saving images
Label2.Caption = "Saving Images"
Dim tmp_imageName As String
Dim HTML_img_element As MSHTML.HTMLImg
Dim strFolder As String, strImageName As String, iCounter As Integer
For Each HTML_img_element In WebBrowser1.document.images
'this following line is to discover name of the file, it may change according to the webpage structure
tmp_imageName = Mid(HTML_img_element.src, InStr(1, HTML_img_element.src, "/images/", vbTextCompare) + 8)
If InStr(1, txtTemp, tmp_imageName, vbTextCompare) Then
'Finding where starts the name of the picture
For iCounter = Len(tmp_imageName) To 1 Step -1
If InStr(iCounter, tmp_imageName, "/", vbTextCompare) Then
Exit For
End If
Next
strImageName = Mid(tmp_imageName, iCounter + 1)
If iCounter = 0 Then iCounter = 1
Label2.Caption = "Saving Images to /images/" & Left(tmp_imageName, iCounter - 1)
strFolder = Left(tmp_imageName, iCounter - 1)
'Path to save image
strFolder = ThisWorkbook.Path & "/images/" & strFolder
URLDownloadToFile 0, HTML_img_element.href, strFolder & "/" & strImageName, 0, 0
End If
Next
Label2.Caption = "idle ---> File " & sURLArchive & " sucessfuly saved."
End Sub