| |
流れとしてはこんな感じになるのでは、と思います。
’-----------------------------------------------------------
Option Explicit
'StreamTypeEnum
Const adTypeBinary = 1
Const adTypeText = 2
'LineSeparatorsEnum
Const adCR = 13
Const adCRLF = -1
Const adLF = 10
'StreamWriteEnum
Const adWriteChar = 0
Const adWriteLine = 1
'SaveOptionsEnum
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
Sub Try2()
Dim f As String
Dim DeskTop As String
'Desktop\HTML\ の UTF-8形式の*.htmlファイルを読む（改行コード:CrLf）
DeskTop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
DeskTop = DeskTop & "html\" '◆テスト用
f = Dir$(DeskTop & "*.html")
Do While Len(f) > 0
'処理
ReplaceUTF8 DeskTop & f '●UTF8テキストファイル読み込み
'次のファイル
f = Dir$()
Loop
MsgBox DeskTop & " ---- All File Replaced"
End Sub
Private Sub ReplaceUTF8(Filename As String)
Dim ss As String
Dim newFilename As String 'テストのため別名で保存
'----ファイルを開いてテキストを読み込む
With New ADODB.Stream
.Type = adTypeText 'adTypeText:2
.Charset = "UTF-8"
.LineSeparator = adCRLF '改行コードの指定
.Open 'StreamObjectのOpen
.LoadFromFile Filename 'Utf-8ファイルを Stream に読み込む
.Position = 0 'ポインタを先頭へ(不要か？)
ss = .ReadText() 'ReadAll As Unicode
.Close
End With
'-------テキスト置換作業
ss = myReplace(ss) '● simpleさんのRegExp置換処理ルーティンへ
'---- 変換後のテキストをUTF-8形式で保存(◆未完成)
Dim j&
j = InStrRev(Filename, "\")
newFilename = "D:\HTML" & Mid$(Filename, j)
With New ADODB.Stream
.Type = adTypeText
.Charset = "UTF-8"
.LineSeparator = adLF '改行コードは LFとする
.Open 'StreamObjectのOpen
.WriteText ss, adWriteChar
.SaveToFile newFilename, adSaveCreateOverWrite
.Close
End With
End Sub
Private Function myReplace(ss As String) As String
（以下略）
'-----------------------------------------------------------
以上ですが、まだ不具合があります。
(1) UTF-8形式で（改行コードはわざと元とちがう LF にして）別の場所に
保存しようとしているのですが、LFだけになっていないようです。
（秀丸エディタで確認）
(2) 保存ファイルの先頭に（もとのUTF-8ファイルにはなかった） BOMがつきます。
これも不要なので BOMなしで保存したいのですが、まだコード化してありません。
これについては
ht tp://amano41.hateblo.jp/entry/2014/04/25/145637
あたりを参考に挑戦してみてください。
|
|
kanabun
- 14/10/6(月) 11:40 -
