■ ＶＢＡでＵＴＦ-８文書を一括書き換え ８月２２日
ホームページのCopyrightの更新年号が2022のまま３年経ちました。更新年号は書き換える必要は無いそうですが、ブログやま帽子のCopyrightはワードプレスの機能で2025に書き換えられています。
ファイルの数は３千個余り。これをＶＢＡで一括書き換えしましたので、コードを下記に掲載します。本サイトに特化したコードですが、文字列置換などに応用出来るのではないでしょうか。
このコードを実行すると、書き換えたファイルの文字コードはＵＴＦ-８(ＢＯＭ無し)、
改行コードは Ｌf となります。
注意 元ファイルを上書きしています。必ずバックアップを取ってから実行してください。
【 マクロコード 】
Option Explicit
Dim A As Variant
Dim B As Variant
Dim C As Variant
Dim FileType As String
Dim LastYear As String
Dim tgtWord0 As String
Dim nCorr As Long
'*********************************************************************
'** UTF-8(BOM無し)ファイルのCopyrightを更新する
'** ファイル読込関数（ADODB.Streamを使用）
'*********************************************************************
Sub UTF8Copyright更新()
Dim j As Long
FileType = ".htm"
tgtWord0 = "Copyright"
LastYear = "2025"
nCorr = 0
'対象フォルダーを取得
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
j = MsgBox(Filetype & "ファイルのCopyright年度を更新します。 _
" & vbCrLf & "ＯＫですか？", vbOKCancel)
If j = 1 Then
A = .SelectedItems(1)
Else
j = MsgBox("キャンセルされました。", vbOKOnly)
Exit Sub
End If
'Coryright更新処理
Call CopyrightUpdate(A)
End If
End With
j = MsgBox(nCorr & "個のファイルを更新しました", vbOKOnly)
End Sub
Sub CopyrightUpdate(A)
Dim FSO As Variant
Dim List As Variant
Dim buf As Variant
Dim tmp As Variant
Dim adFile As Variant
Dim pos As Long
Dim pos0 As Long
Dim blen As Long
Dim UList As Variant
Dim adoSt As Object
Dim byteData() As Byte
Set FSO = CreateObject("Scripting.FileSystemObject")
'フォルダ内のファイルをループ
For Each B In FSO.getfolder(A).Files
If InStr(B.Name, ".htm") > 0 Then
Set adoSt = CreateObject("ADODB.Stream")
UList = ""
With adoSt
.Charset = "UTF-8"
.Open
.LoadFromFile B
buf = .ReadText(-1)
'ファイルの改行コードにあわせてLineSeparatorを設定
If InStr(1, buf, vbCrLf) <> 0 Then
.LineSeparator = -1
ElseIf InStr(1, buf, vbCr) <> 0 Then
.LineSeparator = 13
Else
.LineSeparator = 10
End If
'ファイルを1行ずつ読み込み最終年度を更新する
.LoadFromFile B
Do Until adoSt.EOS
buf = .ReadText(-2)
pos = InStr(buf, tgtWord0)
If pos = 0 Then
Else
blen = Len(buf)
pos0 = InStr(buf, "-")
buf = Left(buf, pos0) & LastYear & Right(buf, blen - pos0 - 4)
nCorr = nCorr + 1
End If
If InStr(1, buf, vbLf) = 0 Then
buf = buf & vbLf
End If
UList = UList & buf
Loop
.Close
'改行コードをLFに設定してBOM有りUTF-8ファイルを書き出す
.Charset = "UTF-8"
.LineSeparator = 10
.Open
.WriteText UList
'BOM無しにして入力ファイルを上書きする
.Position = 0
.Type = 1
.Position = 3
byteData = .Read
.Close
.Open
.Write byteData
.SaveToFile B, 2
.Close
End With
Set adoSt = Nothing
End If
Next
'フォルダ内のサブフォルダをループ
For Each C In FSO.getfolder(A).subfolders
'再帰する
Call CopyrightUpdate(C)
Next
Set FSO = Nothing
End Sub
【 解説 】
Sub UTF8Copyright更新()
* 対象フォルダーを選択、置換プログラムを呼び出し、置換処理したファイル数を
表示して終了します。
* Application.FileDialog(msoFileDialogFolderPicker)で対象フォルダーを指定。
指定したフォルダー内とその下層ホルダー内全ての指定拡張子ファイルが処理
対象となります。
* 設定項目は下記で、目的に合わせて設定値を書き換えます。
FileType = ".htm" ：対象ファイルの拡張子を設定します
tgtWord0 = "Copyright" ：検索文字列を設定します
LastYear = "2025" ：更新年度を設定します
Sub CopyrightUpdate(A)
* "ADODB.Stream"を使用してUTF-8テキストファイルの操作を行っています。
* 改行コード設定 →１行毎の置換処理 → UTF8(BOM付き) → UTF8(BOM無し)
→ 上書き保存 を繰り返して下層を含め対象フォルダーを一括処理します。
* ファイルを１行ずつ読み込むには改行コード(LineSeparator)をファイルに合わせて
設定しなければなりません。ファイルを
ReadText(-1) ：-1 で全行読み込み、2 で１行ずつ読み込み
でファイルを全部読み込み、
InStr(1, buf, vb****)
で改行コードを調べ
CrLf なら .LineSeparator = -1
Cr なら .LineSeparator = 13
Lf なら .LineSeparator = 10
に設定しています。
* 文字列の検索置換はDo ～ Loop内で
ReadText(-1)
で１行ずつ読み込んだ後、置換のコードで処理しています。
* ここのコードを目的に合わせ変更すれば文字列置換ができます。例えば
buf = Replace(1, buf, tgtWord0, LastYear)
に変更すると、tgtWord0 を LastYear に置き換えることが出来ます。
* 処理テスト中に改行が行われずされず１行で出力されることがあり、
If InStr(1, buf, vbLf) = 0 Then
buf = buf & vbLf
End If
この処理を付け加えました。原因は未だに判りません。
* 処理の結果はBOM付きになるので、バイナリーで読み込みBOMを削除します。
* 再帰処理を追加してあるので、一番下層のフォルダーまで一括で処理します。
【 参考サイト 】
Shift_JISのテキストファイルをUTF-8に一括変換
: https://excel-ubara.com/excelvba5/EXCELVBA267.html
Excel VBAでUTF-8形式 HTMLファイルの読み込みと書き込み方法
:https://excel-excel.com/tips/vba_488.html
コードの実行はせいぜい数分ですが、完成までには試行錯誤して思いのほか時間を費やしました（実は、へっぽこなのではいつもの通りなのですが）。まあ、毎日が日曜日の身分なのでこれも良い時間の使い方なのでしょうが、残り時間のカウントダウンが気になるこの頃です。