小池啓仁 ヒロヒト応援ブログ By はてな

小池啓仁(コイケヒロヒト)の動画など。

小池啓仁 ヒロヒト応援ブログ By はてな

VBS版タグ挿入スクリプト

前回のVB6版VBScript版です。


たとえば、フォルダ内にqa0001.htmからqa7000.htmの7000個のhtmファイルがあったとします。
とある事情で、bodyタグの直後にscriptタグを追加したい場合、手作業で追加するのは大変です。
そこで、以下のようなプログラムをVBSで組んで見ました。


以下のプログラムをそのフォルダ内で実行すると一発で7000個ファイルを更新することが出来ます。
2つのRE.Patternの正規表現をカスタマイズして、何かに流用してもらえれば、幸いです。
とにかく、フォルダ内の複数のファイルに対しいて処理するときの雛型として使えると思います。

'---------------------------------------------------------------------------------------------
'[VBS版タグ挿入スクリプト]
'カレントフォルダにある^qa.*htm$でマッチ(正規表現)したファイルすべてにbodyタグの直後にscriptタグを追加する。
'
'---------------------------------------------------------------------------------------------
Option Explicit
    Dim fs, f, f1, fc, RE
    Dim objWshShell

    Set objWshShell = WScript.CreateObject("WScript.Shell")
    Set RE = CreateObject("VBScript.RegExp")
    'カレントフォルダにある正規表現^qa.*htm$でマッチしたファイルすべて処理する。
    
    RE.Pattern ="^qa.*htm$"
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(objWshShell.CurrentDirectory)
    Set fc = f.Files
    For Each f1 in fc
        If RE.Test(f1.name) then
			If TestFileEdit(f1.name) = 1 then
				Exit For
			End IF
        End If 
    Next
    Set fs = Nothing
    Set RE = Nothing
    Set objWshShell = Nothing

Function TestFileEdit(fname)
const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim strPathIn
Dim strPathOut
Dim fs, fr, fw, RE, strWk
Dim intSts

	Set RE = CreateObject("VBScript.RegExp")
	
	RE.Pattern =""

	strPathIn = fname
	strPathOut = "testOut.tmp"
	Set fs = CreateObject("Scripting.FileSystemObject")

	If fs.fileexists(strPathIn) then
 		Set fr = fs.OpenTextFile(strPathIn, ForReading)
		Set fw = fs.OpenTextFile(strPathOut, ForWriting,True)

		Do While Not fr.AtEndOfStream
			strWk = fr.ReadLine
			fw.WriteLine strWk
			If RE.Test(strWk) Then
				fw.WriteLine ""
 			End If
		Loop

		fw.Close
		fr.Close
		Set fw = Nothing
		Set fr = Nothing
		fs.CopyFile "testOut.tmp", fname
		fs.DeleteFile "testOut.tmp"
		intSts = 0
	Else
		Call MsgBox("ファイル見つからない!",48,"エラー")
		intSts = 1
		
	End if
	Set fs = Nothing
	Set RE = Nothing
	TestFileEdit = intSts
End Function