![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
文字コードと改行コードを変更するマクロなのですが今のコードだと
読み込み元の文字コードが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
' 1行ずつ変換
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ベストアンサー
- 回答日時:
こんにちは。
ご自身のコードだと思いますから、少しのアドバイスすればお分かりになると思います。
.xml ファイル自体は、テキストファイルですから、一行目のencodingを読んで判定させればいいのではありませんか。LF がセパレータになっているかは、同じくLF 検索すればよいのではありませんか。
ありがとうございます。
結果的に一行目のencodingと違うものでしたので判定することができませんでした。
しかしながらバイナリで読み込んで特定バイトのところにある0D 0Aを
検索して判定できました。
ありがとうございます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルのVBAについて とあるサイトのコードを参考に、CSVの文字化けを直すVBAを作成しているの 7 2022/11/04 14:15
- Excel(エクセル) Excelにて、フォルダ内のTextファイルをマクロで統合すると文字化けしてしまう時の解消コード 4 2023/01/01 07:32
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Excel(エクセル) マクロでテキストファイルを読み込んだ際の最終セルにデータと改行が含まれる問題の改善方法 2 2022/03/25 16:50
- Excel(エクセル) 【マクロ】スクショ印刷がうまく動かない件 5 2022/12/06 17:37
- Visual Basic(VBA) ①ExcelVBAでカレンダーを作り、別のユザーフォームで日付を入力したいのですがエラーになります。 1 2023/02/17 18:39
- Visual Basic(VBA) VBA 別ブックからの転記の高速化について VBA 別ブックからの転記の高速化についてご教授下さい。 19 2022/07/26 13:07
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Visual Basic(VBA) 数式が消える 1 2023/03/19 16:55
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
wordの何も書かれていない2ペー...
-
Chr(13)とChr(10)の違いは?
-
棒グラフ 横軸の縦書き2列にし...
-
PDFの改行URLを有効にす...
-
wordで均等割り付けをするとき...
-
EXCEL(VBA) 末尾の改行のみ削...
-
【エクセル】セル最後にある無...
-
短歌が1行で収まらない場合、...
-
履歴書の志望動機の所で、「ま...
-
WordにURLを載せると
-
excelで勝手に改行されます
-
VBA フォームのテキストボック...
-
エクセルでセル内改行の複数行...
-
パワーポイントのテキストボックス
-
イミディエイトウインドウの最...
-
バッチで指定ファイルの文末に...
-
VBで倍数を出したい
-
Excel セル内の最初と最後の改...
-
レポートについて質問します 項...
-
一太郎(最新)でのエンターに...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
wordの何も書かれていない2ペー...
-
Chr(13)とChr(10)の違いは?
-
wordで均等割り付けをするとき...
-
【エクセル】セル最後にある無...
-
Accessにインポートしようとす...
-
PDFの改行URLを有効にす...
-
excelで勝手に改行されます
-
棒グラフ 横軸の縦書き2列にし...
-
パワーポイントのテキストボックス
-
VBA フォームのテキストボック...
-
履歴書の志望動機の所で、「ま...
-
イミディエイトウインドウの最...
-
短歌が1行で収まらない場合、...
-
バッチで指定ファイルの文末に...
-
Tera Term のマクロでの改行コ...
-
Excel セル内の最初と最後の改...
-
Access2003で特定列の改行コー...
-
エクセルでセル内改行の複数行...
-
TeraPadで改行が
-
WordにURLを載せると
おすすめ情報