ページのURL取得スクリプト


指定したURL内にあるリンクをテキストに出力するスクリプト
ただ、たまにエラーがでることがあるのでOn Errorを追加した。あくまで未完成・・・


getLinkUrl.vbs

'--------------------------------------------------------------------------------------
'
'	Aタグ取得スクリプト
'			(指定したURL内にあるAタグのhrefをテキストに出力する)
'
'	注意点	スクリプト実行前にすべてのInternet Explorerを終了してください。
'
'	動作確認環境	Windows XP SP2 ,Internet Explorer 6 SP2
'
'--------------------------------------------------------------------------------------
'*********************************************************************
'
'	メイン処理
'
'*********************************************************************

ON ERROR RESUME NEXT

	' ダウンロードするページの URL
	sURL = InputBox("リンクを取得するURLを指定してください。","URLの指定","")

	' 出力先フォルダ+ファイル名
	sFileName = "D:\\urlList.txt"

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

	Dim bLoadComplete

	bLoadComplete = False

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

	'リンク先のAタグをすべて取得してテキストへ出力
	For i = 0 To Ie.Document.all.tags("A").length - 1

		oTF.Write Ie.Document.all.tags("A")(i).href
		oTF.Write vbCrlf
	Next

	oTF.Close

Wscript.Echo "URL取得完了" 

'*********************************************************************
'
'	サブルーチン
'
'*********************************************************************
' 指定した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