csvファイルの文字コードを変更するvbaコード

質問

お世話になってます。

¥C:User¥documentのフォルダにあるBefore.csv(中身の文字コードはUnicode)のデータを文字コードをUft-8に変更して別名保存して
同フォルダ内のAfter.csv(元々あるファイルでも新規作成でも大丈夫です)として保存するvbaコードを教えてもらえませんか。

毎週使痛いコードなのでよろしくお願いします。

回答No.5

Prome_Lin · ベストアンサー

回答No.3です。

「VBA」そのものです。

なお、後ろに「VBScript」の改良版を掲載します。

一度でいいので、使ってみてください。

使い方は、以前の説明と同じで、プログラムを、メモ帳かテキストエディタに貼り付け、「～.vbs」という名前で保存します。

「～」の部分は、何でもかまいませんが、「.vbs」の部分は、必ず半角です。

できたプログラムファイル（「～.vbs」ファイル）に、「csv」ファイルを１つだけ、ドラッグ＆ドロップするだけです。

ドラッグ＆ドロップしたファイルと同じフォルダ内に「After.csv」という、結果ファイルを作成します。

では、「VBA」版です。

基本的に、全く同じですが、「VBA」では、ドラッグ＆ドロップなどできませんので、特定の「Before.csv」（今は、私の環境の「D:\Programming」フォルダ内）を、「After.csv」（やはり、「D:\Programming」フォルダ内）を作成していますので、質問者の環境に合わせてください。

Sub Sample()
Set ab = CreateObject("ADODB.Stream")
ab.Type = 2
ab.Charset = "Unicode"
ab.Open
ab.LoadFromFile "D:\Programming\Before.csv"
a = ab.ReadText(-2)
ab.Close
Set ab = Nothing
Set ab = CreateObject("ADODB.Stream")
ab.Type = 2
ab.Charset = "UTF-8"
ab.Open
ab.WriteText a, 0
ab.SaveToFile ("D:\Programming\After.csv")
ab.Close
Set ab = Nothing
MsgBox ("Finished!")
End Sub

次に、「VBScript」の改良版です。

こちらは、ドラッグ＆ドロップするファイルの名前は何でもかまいませんが（「拡張子」は、必ず「csv」でなければなりませんが）、結果ファイルをドラッグ＆ドロップしたファイルと同じフォルダ内に「After.csv」という名前で作成します。

Option Explicit
Dim a, ab, f, gf, so, wa
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments
If wa.Count <> 1 or LCase(so.GetExtensionName(wa(0))) <> "csv" Then
MsgBox("ドラッグ＆ドロップできるのは、csvファイル１つだけです")
WScript.Quit
End If
f = Left(wa(0), InStrRev(wa(0), "\"))
Set ab = CreateObject("ADODB.Stream")
ab.Type = 2
ab.Charset = "Unicode"
ab.Open
ab.LoadFromFile wa(0)
a = ab.ReadText(-2)
ab.Close
Set ab = Nothing
Set ab = CreateObject("ADODB.Stream")
ab.Type = 2
ab.Charset = "UTF-8"
ab.Open
ab.WriteText a, 0
ab.SaveToFile(f & "After.csv")
ab.Close
Set ab = Nothing
Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

最後に、読まなくてもいいですが、私としては、「Unicode（UTF-16）」の「～.csv」ファイルを「UTF-8」に変換するだけなのに、重たいエクセルを立ち上げる意味があるのでしょうか？

エクセルの機能は全く使っていませんので、エクセルを立ち上げることに何の意味もありません。

「VBScript」なら、ドラッグ＆ドロップするだけです。

しかも、「VBScript」のドラッグ＆ドロップの部分を取り除いて、ファイルを指定しているだけで、全くそのままです。

お礼

お礼が大変遅くなって申し訳ありません。
やってみたのですが、私の勉強不足で文字化けしてしまいます。
質問締め切り後も、ご提示のコードで挑戦＆勉強を継続したいと思います。
遅くなって申し訳ありませんでした。
詳しい説明をありがとうございます。

補足

私のためにコードを作成ありがとうございます
自宅に帰り動作確認させていただきます
遅くなり失礼しました

回答No.4

chie65536（@chie65535）

＞親プログラムの呼び出し元は、ご提示のサイトのどこにありますか？

提示したサイトには「部品」しかありません。呼び出し元（親プログラム）は自作して下さい。

お礼

もっと勉強します。
ありがとうございます！

回答No.3

Prome_Lin

「VBScript」による回答ですので、無視していただいて結構です（「Windows限定」です）。

このプログラムは、「csv」ファイルを１つだけ、プログラムファイルにドラッグ＆ドロップするだけです。

直接、書き換えられなかったので、「abc.csv」をドラッグ＆ドロップした場合、「abc.xyz」というファイルをいったん作成し、元の「abc.csv」ファイルを削除、その後「abc.xyz」を「abc.csv」に換える、という処理をしていますので、こちらで、問題なく動くのを確認はしていますが、必ず、コピーのファイルなど、試してから、実際のファイルで使ってください。

以下のプログラムを、メモ帳かテキストエディタに貼り付け、「～.vbs」という名前で保存します。

「～」の部分は、何でもかまいませんが、「.vbs」の部分は、必ず半角です。

できたプログラムファイル（「～.vbs」ファイル）に、これから処理したい「csv」ファイルを１つだけ、ドラッグ＆ドロップするだけです。

Option Explicit
Dim a, ab, f, gf, n, so, wa
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments
If wa.Count <> 1 or LCase(so.GetExtensionName(wa(0))) <> "csv" Then
MsgBox("ドラッグ＆ドロップできるのは、csvファイル１つだけです")
WScript.Quit
End If
f = Left(wa(0), InStrRev(wa(0), "\"))
n = so.GetBaseName(wa(0))
Set ab = CreateObject("ADODB.Stream")
ab.Type = 2
ab.Charset = "Unicode"
ab.Open
ab.LoadFromFile wa(0)
a = ab.ReadText(-2)
ab.Close
Set ab = Nothing
Set ab = CreateObject("ADODB.Stream")
ab.Type = 2
ab.Charset = "UTF-8"
ab.Open
ab.WriteText a, 0
ab.SaveToFile(f & n & ".xyz")
ab.Close
Set ab = Nothing
Set gf = so.GetFile(f & n & ".xyz")
so.DeleteFile wa(0), True
gf.Name = n & ".csv"
Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

簡単な説明です。

Option Explicit

「厳密に」というような意味ですが、気にしないでください。

Set so = CreateObject("Scripting.FileSystemObject")

ファイルやフォルダを扱えるようにしています。

Set wa = WScript.Arguments
If wa.Count <> 1 or LCase(so.GetExtensionName(wa(0))) <> "csv" Then
MsgBox("ドラッグ＆ドロップできるのは、csvファイル１つだけです")
WScript.Quit
End If

ドラッグ＆ドロップされるのを待っていて、ドラッグ＆ドロップされると、ファイルの個数や拡張子を調べて、想定外なら、メッセージを表示して、プログラムそのものを終了してしまいます。

f = Left(wa(0), InStrRev(wa(0), "\"))
n = so.GetBaseName(wa(0))

ドラッグ＆ドロップされたファイルのフォルダとベースネーム（「abc.csv」→「abc」）を調べています。

Set ab = CreateObject("ADODB.Stream")

「UTF-8」を扱うのに費用ですが、まず、「Unicode」の処理から、

ab.Type = 2
ab.Charset = "Unicode"
ab.Open
ab.LoadFromFile wa(0)
a = ab.ReadText(-2)
ab.Close
Set ab = Nothing

ドラッグ＆ドロップされたファイルを、「Unicode」として、ファイル全体を一気に読み込んで「a」に入れて、閉じています。

Set ab = CreateObject("ADODB.Stream")
ab.Type = 2
ab.Charset = "UTF-8"
ab.Open
ab.WriteText a, 0
ab.SaveToFile(f & n & ".xyz")
ab.Close
Set ab = Nothing

今、読み込んだファイルを「UTF-8」で、「～.xyz」で書き出しています。

Set gf = so.GetFile(f & n & ".xyz")

書き出したファイルを取得しています（ファイル名の変更に必要）。

so.DeleteFile wa(0), True

元々の「～.csv」ファイルを削除。

gf.Name = n & ".csv"

「～.xyz」→「～.csv」。

Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

あとは、終了処理ののち、「Finished!」と表示しています。

補足

御紹介ありがとうございます。
vba操作で、自動化を目指しているのですが、
そのVBScriptをExcelvbaから操作することは難しいでしょうか？

回答No.2

chie65536（@chie65535）

＞ご提示された頁のコードの”Option Explicit”～最下層までを標準モジュールに貼り付けて、F５を押しましたが動きません。

これらの関数は、すべて「部品」で、単体では動作しません。これらの部品を呼び出す「親プログラム」つまり「呼び出し元」が必要です。

「呼び出し元」では「読み込み、書き込み用にそれぞれのcsvファイルを開く」「開いている読み込みファイルから１行読み込む」「読み込んだ１行の文字列を、部品の関数に渡し、結果を受け取る」「受け取った結果を開いている書き込みファイルに１行書き込む」「すべての行を処理したらファイルを閉じる」と言う処理が必要です。

補足

度々すみません
親プログラムの呼び出し元は、ご提示のサイトのどこにありますか？
理解力なくて申し訳ありません

回答No.1

chie65536（@chie65535）

http://nonsoft.la.coocan.jp/SoftSample/SampleModADOS.html

補足

URLありがとうございます。
ご提示された頁のコードの”Option Explicit”～最下層までを標準モジュールに貼り付けて、F５を押しましたが動きません。
どうしたら良いでしょうか？
度々ご面倒おかけいたします。