文字コード変換で文字コード取得

質問

文字コードと改行コードを変更するマクロなのですが今のコードだと
読み込み元の文字コードがUTF-8のLFでないと正しい形で取り込むことができません。
そこで文字コードがUTF-8か改行コードがLFの時という条件を組みたいのですが色々試したのですができません
皆様のお力をおかしください。

Sub UTF8_LF→SJIS_CRLF()

Dim strFilePath As String
Dim objReadStream As Object
Dim objWriteStream As Object
Dim bytData() As Byte

Const adTypeText = 2
Const adTypeBinary = 1
Const adReadLine = -2
Const adWriteLine = 1
Const adLF = 10
Const adCRLF = -1
Const adSaveCreateOverWrite = 2
Dim opnFile As Variant
Dim fFilter As String
Dim i As Integer

fFilter = "xml Files ,*.xml"
opnFile = Application.GetOpenFilename(FileFilter:=fFilter, MultiSelect:=True)
If IsArray(opnFile) Then
For i = 1 To UBound(opnFile)
strFilePath = opnFile(i)

Set objReadStream = CreateObject("ADODB.Stream")
Set objWriteStream = CreateObject("ADODB.Stream")

' 読み込み元(Shift_JIS,CRLF)
With objReadStream
.Open
.Type = adTypeText
.Charset = "UTF-8"
.LineSeparator = adLF
.LoadFromFile strFilePath
End With
' 書き込み先(UTF-8,LF)
With objWriteStream
.Open
.Type = adTypeText
.Charset = "Shift_JIS"
.LineSeparator = adCRLF
End With

' １行ずつ変換
Application.DisplayStatusBar = True 'ステータスバーの表示
Application.StatusBar = Dir(opnFile(i)) & "を取得中・・・" 'ステータスバーに文字列表示
Do Until objReadStream.EOS
objWriteStream.WriteText objReadStream.ReadText(adReadLine), adWriteLine
Loop
Application.StatusBar = False 'ステータスバーの制御を通常に戻す
objReadStream.Close

With objWriteStream
.Position = 0
.Type = adTypeBinary
.Position = 0
bytData = .Read
.Close

.Open
.Position = 0
.Type = adTypeBinary
.Write bytData
.SaveToFile strFilePath, adSaveCreateOverWrite
.Close
End With

Next

Else
MsgBox "キャンセルしました"
End
End If

宜しくお願いします。

回答No.1

Wendy02 · ベストアンサー

こんにちは。

ご自身のコードだと思いますから、少しのアドバイスすればお分かりになると思います。
　.xml ファイル自体は、テキストファイルですから、一行目のencodingを読んで判定させればいいのではありませんか。LF がセパレータになっているかは、同じくLF 検索すればよいのではありませんか。

お礼

ありがとうございます。
結果的に一行目のencodingと違うものでしたので判定することができませんでした。
しかしながらバイナリで読み込んで特定バイトのところにある0D 0Aを
検索して判定できました。

ありがとうございます。