CSVで文字化けしてしまうのを直すマクロ

Question

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列２行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5～10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/file10.htm

例　空白→""、　神奈川→"神奈川"

やりたいこととしてはファイル名とあるシートのA列2行目に書いてあるCSVファイルを開き、文字化けを直してSheet1にデータを表示させ、それをファイル名が書いてある最終行まで行いたいです。

Sub macro()
Dim i1 As Long, x As Long
Rbook As Workbook
Rsheet As Worksheet, Ssheet As Worksheet
Set Rbook = ThisWorkbook

Sheets("ファイル名").Select
Set Rsheet = Rbook.Worksheets("ファイル名")
For i1 = 2 To 10
If Rsheet.Cells(i1, 1).Value <> "" Then 
Sheets("SHEET1").Select　’表示させるシート
Set Ssheet = Rbook.Worksheets("SHEET1")
Ssheet.Cells.Clear
Ssheet.Range("A1").Select

’文字化けを直す
  Dim buf As String, Target As String, i1 As Long
    Dim tmp As Variant, j As Long
    Target = "￥アドレス" & Ssheet.Cells(i, 1).Value
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8"
        .Open
        .LoadFromFile Target
        Do Until .EOS
            buf = .ReadText(-2)
            i = i + 1
            tmp = Split(buf, ",")
            For j = 0 To UBound(tmp)
                Cells(i, j + 1) = tmp(j)
            Next j
        Loop
        .Close
    End With

’別のマクロ実行

End if 
Next i1 

’2行目、3行目と続く

End Sub

どうぞよろしくお願い致します。

WindFaller · Accepted Answer

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、２番めに同じように起こりますか？

Next j
　　Loop
　　.Close
　End With
　Set Strm = Nothing   '←は入れたらどうでしょうか。
End Sub　'←ここが最後の行

それと、私は、参照設定で、Adodb を入れていること。(Microsoft ActiveX Data Objects 2.8 Library)
Dim Strm As ADODB.Stream

これらは、あまり関係ないけれども、実際に自分がする時はこうします。もちろん、ご質問者さんが選んだ方法を完動するように書き上げただけですから、この延長上に、同様のエラーがなくなるという可能性は低いのではないかと思います。

今、思いついたのは、Excel 関数のClean 関数を間に入れる方法はあるとは思います。
それは、エラーを起こすと予想されるバイナリコードを除去する働きがあります。ただし、エラーがバイナリコードであれば、という条件です。

しかし、こちら側では、根本的な解決策は見当たりません。が、何度もトライするよりも、ダメだったファイルが、どうしてだめだったか、エディターなどで調べていただいたほうが良いですね。そちらのほうが早いのです。
巨大なファイルではない限りは、文字変換で、UTF-8 から、SJISに変換するツールで、一旦変更してから、インポートするほうが楽だと思います。Vector で、Unix系のツールなどいくつかあるようです。

WindFaller · Answer

こんばんは。

補足は読んでおりませんので、そのままここにアップロードします。

エラー付きのコードを出していただいても、今ひとつはっきりしないので、ご質問の要点をまとめますと、
・CSVは、UTF-8 であること（ただし、BOMあり、BOMなし不明)
・ファイ名というシート名の部分のA2 からA列に対してCSVファイルの一覧があるということ。その数は不定であること。
・Sheet1 に連続してインポートしていくこと。
・その中の「""(コーテーションマーク)」は不要であると。(これは、Replaceを使うのが一般的です)
---------------------------
BOM付きなら、なんとかなるはずですが、このプログケラムには、UTF-8を選別することが出来ないという欠点があるので、UTF-8決まったものとします。このファイルのパスは、この実行しているワークブックと同じ場所にあるということになっていますので、場所が違う場合は適宜変えてくたさい。。

'//標準モジュール
Sub CSVImportCSV()
　Dim Fname As String
　Dim i As Long, j As Long
　Dim myPath As String
　Worksheets("Sheet1").UsedRange.Clear
　myPath = ThisWorkbook.Path & "\"　　'パス
　With Worksheets("ファイル名")
　　For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
　　　Fname = myPath & .Cells(i, 1).Value
　　　If Dir(Fname, vbNormal) <> "" Then　'ファイルの存在のチェック
　　　　Call CSVConverter(Fname)
　　　Else
　　　　.Cells(i, 2).Value = "missing"　'ファイルがない場合は、B列に表示
　　　End If
　　Next i
　End With
End Sub
Private Sub CSVConverter(ByVal Fname As String)
　Dim Strm As Object
　Dim i As Long, j As Long
　Dim buf As Variant
　Dim sh As Worksheet
　Dim Lastrow As Long
　Set Strm = CreateObject("ADODB.Stream")
　Set sh = Worksheets("Sheet1")　　'出力シート
　i = sh.Cells(Rows.Count, 1).End(xlUp).Row '行の最後
　With Strm
　　.Charset = "UTF-8" 'Encording
　　.Open
　　.LoadFromFile Fname
　　Do Until .EOS
　　　buf = .ReadText(-2)
　　　buf = Replace(buf, """", "")
　　　arg = Split(buf, ",")
　　　i = i + 1
　　　For j = 0 To UBound(arg)
　　　　sh.Cells(i, j + 1) = arg(j)
　　　Next j
　　Loop
　　.Close
　End With
End Sub

fujillin · Answer

こんにちは

いろいろ不明点はありますが・・・

＞文字化けはしないものの文字に必ず""がついてしまい、
「"」が付け加えられるという意味でしょうか？
ご質問文ではそのように読めるけれど、そんなかとは無いのではないでしょうか。
元のCVSデータが、クォーテーション付きのCSVになっているだけではと推測しますが？

クォーテーションが邪魔であるなら、個別のデータにした時点で、『最初と、最後の1文字が"なら、両方取り除く』という処理を通るようにすれば外せると思います。
必ず、クォーテーション付きと決まっているなら、チェックの必要もなく、最初と最後の1文字を無条件で削除すれば良いでしょう。

＞また一行しか転記されません。
転記された一行分は、最初の行でしょうか、最後の行でしょうか？
最初の一行であれば、二行目に移る前に処理が中断（または終了）していると推測できます。
最後の一行なら、全行処理しているけれど上書きしているなどの可能性が・・・

とはいえ、出力の行を制御している変数iの初期値設定がどこにも見当たらないけれど、エクセルマクロのデフォルトに任せてるって言うことでしょうか？
（行の制御では、特に問題にはならないかも知れませんが…）

ついでながら、ご提示のコードをざっと眺めて、わからない部分がいろいろと・・・

＞Target = "￥アドレス" & Ssheet.Cells(i, 1).Value
が実行される前に、
＞Ssheet.Cells.Clear
でシート内をクリアしちゃってるけれど、Cells(i, 1).Valueで何を取得するつもりなのでしょうか？

さらには、その際の変数iはデフォルトだと空白（又は0）となっていて、セル参照に失敗するはずと思うのですが・・・
と言うものの、ご質問文ではファイルが読めているようなので、さっぱりわからないところです。

CSVで文字化けしてしまうのを直すマクロ

こんにちは。

こんばんは。

こんにちは

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング