あるフォルダ以下のHTMLのキャプチャをJpegで取りまくる

任意のディレクトリ以下のHTMLのキャプチャをJpegで取り、
同じディレクトリ構造配下へ格納するVBScriptを書いてみた。

ちなみにVBscriptは初体験。（免罪符？）

Option Explicit

Private FSO
Private SourcePath
Private CapturePath
Private ThisFolder
Private f
Private WshShell
Dim WSH,wExec

'■必要なパラメータは↓ここで調整
SourcePath = "C:\test\testdir" 'ここにHTMLソースを置く
CapturePath = "C:\test\capture" 'ここにJPEGが出力される。

'■出力ディレクトリが合ったらエラーで終了。無いときは作る。
'　なぜなら、その後の処理で中身を全部消してしまうから。

Set FSO = CreateObject("Scripting.FileSystemObject")

if FSO.FolderExists(CapturePath) then
MsgBox CapturePath & "フォルダが存在するため処理を終了します。"
WScript.Quit 1
ELSE
FSO.CreateFolder CapturePath
End if

'■フォルダコピー
Set ThisFolder = FSO.GetFolder(SourcePath)
ThisFolder.Copy CapturePath & "\", True

Set FSO = Nothing
Set ThisFolder = Nothing

'■HTMLのファイルリストを取得
Set WSH = CreateObject("WScript.Shell")
Set wExec = WSH.Exec("%ComSpec% /c ""dir " & SourcePath & "\*.htm* /b/a-d/s > HtmList.txt""")
Set wExec = Nothing
Set WSH = Nothing

'■悪いけどディレクトリの中身は消えていただきます。

'キャプチャー出力ファイルの実行予定一覧取得
Set WSH = CreateObject("WScript.Shell")
Set wExec = WSH.Exec("%ComSpec% /c ""dir " & CapturePath & "\*.htm* /b/a-d/s > CapList.txt""")
Set wExec = Nothing
Set WSH = Nothing

'キャプチャーディレクトリの中身の削除対象リスト取得
Set WSH = CreateObject("WScript.Shell")
Set wExec = WSH.Exec("%ComSpec% /c ""dir " & CapturePath & "\* /b/a-d/s > DelList.txt""")
Set wExec = Nothing
Set WSH = Nothing

MsgBox CapturePath & "ディレクトリリストを取得しました。"

'ここでWaitを入れないと、DelListができあがらないうちに次の処理が走るとエラーになる。
'ループしてファイル削除
'★　ファイルの存在と書き込みできるか確認を入れる。

Private FileName
Private i

Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile("c:\test\DelList.txt")
While Not .AtEndOfStream
i = i + 1
'WScript.Echo i & .ReadLine
FSO.DeleteFile .ReadLine
Wend
.Close
End With
Set FSO = Nothing

'■そのファイルごとに出力を掛けるループ

'取得元ファイル名を取り出す
Private SourceFile(99999)
i = 0

Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile("c:\test\HtmList.txt")
While Not .AtEndOfStream
i = i + 1
SourceFile(i) = .ReadLine
Wend
.Close
End With
Set FSO = Nothing

'保存先ファイル名を取り出す
Private CaptureFile(99999)
i = 0

Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile("c:\test\CapList.txt")
While Not .AtEndOfStream
i = i + 1
CaptureFile(i) = .ReadLine
Wend
.Close
End With
Set FSO = Nothing

'バッチファイルでも出力するか？

Private j
Set FSO = CreateObject("Scripting.FileSystemObject")

With FSO.OpenTextFile("c:\test\AllCap.bat",8,True)

For J = 1 to i
'★一応中身確認しようか、ドッチかがが空だったらエラーにしよう
.WriteLine "c:\crena\CrenaHtml2jpg.exe -o"""& CaptureFile(j) &".jpg"" -fjpeg -w240x1200 -s240x1200 -q80 -t25 -u""" & SourceFile(j)
Next

.Close
End With

Set FSO = Nothing

'バッチファイルを叩く。

Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "c:\test\AllCap.bat ",1,true
Set WshShell = Nothing

'終わり

何がしたいかというと、特定のディレクトリ以下のHTMLの画面キャプチャーを全部取る。
ってJpegにして同じディレクトリ構造で保存するというもの。

ダウンロード・CrenaHtml2jpg ＷＥＢページをサムネイル画像に！

http://dip.picolix.jp/disp5.html

のスクリプトを使います。

■使い方

上記のソースをc:\test\capture.vbsに保存

c:\crenaにダウンロードしたスクリプトを配置。

c:\test\testdir　にHTMLファイルを置き

VBSを実行すると、
c:\capture配下に、testdirと同じディレクトリ構造で、
＊.html.jpgというファイルを吐きまくる。

画面サイズは携帯用になっているので、240x1200という不思議なサイズになっています。
そこは、Crenaのexeを叩くパラメタを調整してみて下さい。

まだ、中間ファイル吐いてたりできは悪いが、晒してしまえという感じ。

今後、更新していく予定。

■今後やりたいこと
　・ファイルへのデータ吐き出しをやめる。（WSQLあたりでどうにかする。）
　・ディレクトリ構造をdirコマンドじゃない状態で取りたい。
　・出力したJpegファイルを、PowerPointのファイルを作成し、
　　｛新しいスライドを追加して、Jpegを中央に貼り付け｝ファイル分だけループする。
　　↑できた。2008/01/24。ソースは後日公開。
　・タイトルはパス名 or

■さらに！これできたら良いなあぁ
　・ついでに、HTMLの中のテキスト要素を抜き出して、同じページのテキストボックスに書き出す。
　　↑できた。2008/01/25。ソースは後日公開。
　・リンク先のページIDを拾って、リンク先を表示

これが出来ると、今の仕事がかなり楽になるんだよなぁ・・・・

ということで、今後もボチボチ更新する予定。

では、おやすみなさい。