Webサイトのダウンロードスクリプト

配列に定義したURLのHTMLをまとめてダウンロードするスクリプト。
オフラインで読みたいBlogなどまとめて保存しておきたいと思いつくってみた。

webdownload.vbs

'--------------------------------------------------------------------------------------
'
'	Webページダウンロードスクリプト
'			(指定したURLのHTMLをダウンロードする)
'
'	注意点	スクリプト実行前にすべてのInternet Explorerを終了してください。
'
'	動作確認環境	Windows XP SP2 ,Internet Explorer 6 SP2
'
'--------------------------------------------------------------------------------------
'
'*********************************************************************
'
'	メイン処理
'
'*********************************************************************

	' ダウンロードするページの URLの定義 (配列で複数のURLを指定できます)
	Dim aURLList(256)

	aURLList(0) = "http://d.hatena.ne.jp/haradago/?of=1"
	aURLList(1) = "http://d.hatena.ne.jp/haradago/?of=2"
	aURLList(2) = "http://d.hatena.ne.jp/haradago/?of=3"

	' ファイルを保存するフォルダ名の定義(末尾に\を付ける事！！)
	sSaveToFolder = "D:\download\"


	Dim sURL
	Dim bLoadComplete

	Set Ie = WScript.CreateObject("InternetExplorer.Application", "IE_")
	Set oFS = WScript.CreateObject("Scripting.FileSystemObject")

	'定義したURLの終端までループ
	For Each sURL In aURLList

		If sURL = "" Then
			Exit For
		End If

		bLoadComplete = False

		' ページの取得と保存
		GetWebDocument (sURL)

		'IEよりHTMLを取得
		sSrcHTML = Ie.Document.all.tags("HTML")(0).innerHTML

		'取得したHTMLを名前を付けて保存する
		SaveToFile GetFileNameToSave(sSaveToFolder,sURL), sSrcHTML

	Next

Wscript.Echo "DownLoad完了" 

'*********************************************************************
'
'	サブルーチン
'
'*********************************************************************
' 保存するファイル名を編集する
Function GetFileNameToSave(sFolderName, sFileName)

	' ファイル名に使用しない文字を除去
	sFileName = Replace(sFileName, "?http://", "")
	sFileName = Replace(sFileName, "/", "_")
	sFileName = Replace(sFileName, ":", "_")
	sFileName = Replace(sFileName, "?", "_")

	GetFileNameToSave = sFolderName & sFileName & ".html"

End Function

' HTMLをテキストをファイルに保存する
Sub SaveToFile(sFileName, sHTMLSrc)

On Error Resum Next 'ページがなかった場合、ErrNumber=5が発生するため追加

	Set oTF = oFS.CreateTextFile(sFileName, True)
	oTF.Write sHTMLSrc
	oTF.Close
End Sub

' 指定したURLをロード
Sub GetWebDocument(sURL)

	bLoadComplete = False

	'指定したページを読み込む
	Ie.Navigate (sURL)

	'ロードが完了するまでWait
	Do 
		WScript.Sleep 10
	Loop While bLoadComplete = False

End Sub
'*********************************************************************
'
'	IEのイベント
'
'*********************************************************************
'ロード完了イベント
Sub IE_DocumentComplete(pdisp,surl)
	bLoadComplete = True
End Sub

'IEの終了イベント
Sub IE_OnQuit
	Set Ie = Nothing
	WScript.Quit
End Sub