get links of a website, 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

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s