VBS版タグ挿入スクリプト

VB6,VBA,VBS,EXCEL,DOS,BAT,WSH,WORDの小技メモ

HTML/ CSS/ CGI-Perl/ JavaScript/ JavaApplet/ AccessUp/ Internet/ EnglishLearn/ ちゃいちゃん天使/ 天使メッセージ/ 飯田ワールド/ 結城ワールド/ プロフィール/ WEB相談室/ WEBアンテナ/ 燈明日記/ Perlノート/ 漢字起源/ yahoo

はじめに

本ページは、ウインドウズ系全般のティプスメモです。

そう、はじめはVB系のティプスメモだったのですが…いつの間にか、ウインドウズ系全般のティプスメモになってしまいました。

ちなみに、ティプス(Tips)とは、マニュアルに書かれていない技法や裏わざのことですが、本ページでは、私が経験してこれはと思ったノウハウのメモになっています。

尚、以下は本サイトの最新情報(ブログ)です。

それでは、本ページが何かのお役に立てれば幸いです。ごゆっくりご覧ください。

◆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 ="<body>"

 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 "<script src=""header.js"" type=""text/javascript"" charset=""Shift_JIS""></script>"
    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

おわりに

以下のページには、すべてのTIPSがあります。もしよろしければ、どうぞ!

尚、ご感想、ご意見、誤字、脱字、間違い等がありましたら遠慮なくVB-TIPS掲示板へご指摘ください。

人のよいところをどんどん見つけよう