Post by fher182I need help for creating a VBScript that can retrieve HTML from a given
web site (perhaps typing the URL in an Inputbox) and the store that in
my local computer.(the HTML)
Any Idea?
Not a straight answer.
I use the following HTA to add new context menu to the anchors in the page
which is showed by IE.
The menu save the entire page as a web archive file (*.mht) to the folder,
%userprofile%\My Documents\HomePages\
<!-- FileName : SaveMhtmEn.hta -->
<html><head><script language=vbs>
Dim EvtSrc, WS, FS, URL, Path, Title, EN
Set WS = CreateObject("WScript.Shell")
Set FS = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set EvtSrc=external.menuarguments.event.srcelement
EN = Err.Number
On Error GoTo 0
If EN <> 0 Then Reg_UnReg
'
Sub SaveAsMhtml()
URL = EvtSrc.Href
If IsNull(URL) Or LCase(Left(URL, 7)) <> "http://" Then _
ShowMessage 1
Path = "%userprofile%\My Documents\HomePages\"
Path = WS.ExpandEnvironmentStrings(Path)
If Not FS.FolderExists(Path) Then FS.CreateFolder Path
external.menuarguments.status = "Now downloading..."
With CreateObject("InternetExplorer.Application")
.Navigate URL
Do While .Busy: Loop
Title = .Document.Title:If Title = "" Then Title = ":"
With CreateObject("CDO.Message")
On Error Resume Next
.CreateMHTMLBody(URL)
If Err Then On Error GoTo 0: ShowMessage 2
FS.CreateTextFile Path & Title & ".mht"
If Err Then _
Title = Replace(Date, "/", "_") & "_" & Replace(Time, ":", "_")
On Error GoTo 0
.BodyPart.GetStream.SaveToFile Path & Title & ".mht", 2
End With
.Quit
End With
external.menuarguments.status = ""
ShowMessage 3
End Sub
'
Sub ShowMessage(Mes)
Select Case Mes
Case 1: WS.PopUp "No link address.", 2
Case 2: WS.PopUp "Downloading failed", 2
Case 3: WS.PopUp "Downloading finished.", 2
End Select
window.close
End Sub
'
Sub Reg_UnReg()
Const RootKey = "HKCU\Software\Microsoft\Internet Explorer\MenuExt\"
Const Name = "SaveAs &Mht Format"
Dim Path, TKey, Dummy, EN
Path = document.urlunencoded
TKey = RootKey & Name & "\"
On Error Resume Next
Dummy = WS.RegRead(TKey): EN = Err.Number
On Error GoTo 0
If EN = 0 Then
WS.RegDelete TKey
WS.PopUp "Deleted from context menu", 2
Else
WS.RegWrite TKey, Path, "REG_SZ"
WS.RegWrite TKey & "contexts", &H20, "REG_DWORD"
WS.PopUp "Added to context menu", 2
End If
window.close
End Sub
</script></head><body onload=SaveAsMhtml></body></html>
--
Miyahn (Masataka Miyashita) JPN
Microsoft MVP for Microsoft Office - Excel(Jan 2006 - Dec 2006)
***@nifty.ne.jp