複数のCSVファイルを一つのブックに

質問

エクセルvbaの達人の皆様、どうか助けてください。
フォルダ内の複数のCSVファイルを一つのブックにシートを分けて取り込むvbaが知りたいです。問題は、
・複数のcsvを一気に取り組みたい
・一つのブックに、csvファイル別にシートを分けたい
・文字化けを何とかしたい！！（文字コードをutf8にしたい）
この3つをクリアすることですが、、

ネットで調べてみたところ、あるページに載っている以下のマクロを試してみたのですが、やはり文字化けしてしまいます。文字コードの設定をどこかで指定しなければならないと思いますが、どう改良すればよろしいでしょうか。（ちなみに、VBAは全くの初心者です）
Sub test()
Dim myObj As Object
Dim myDir As String
Dim myFileName As String
Dim myc As Long
Application.ScreenUpdating = False
Set myObj = CreateObject("Shell.Application"). _
BrowseForFolder(0, "取り込むフォルダを選択してください", 0)
If myObj Is Nothing Then Exit Sub
myDir = myObj.Items.Item.Path
If Right(myDir, 1) <> "\" Then myDir = myDir & "\"
'フォルダ内のExcelファイルを確認
myFileName = Dir(myDir & "*.csv")
myc = 0
Do While myFileName <> ""
Workbooks.Open (myDir & myFileName)
myc = myc + 1
Workbooks(myFileName).Worksheets(1).Move ThisWorkbook.Worksheets(1)
myFileName = Dir()
Loop
If myc = 0 Then
MsgBox "CSVファイルがありません。"
End If
Application.ScreenUpdating = True
End Sub

（上記のマクロはhttp://www.excel.studio-kazu.jp/kw/20110705155353.html#commentから引用しました。）

回答No.2

nishi6 · ベストアンサー

質問内容のコードを書いてみました。メモ帳でUTF8ファイルを作って、Excelで読む（ダブルクリック）と文字化けし、回答のマクロを実行すると正常に読み込まれることを確認しました。
質問者様のファイル内容が分からないですが、参考に回答します。

下記マクロの「fPath」フォルダーにある複数のCSVファイルを読み込んで、「CSVshtName+番号」のシートを作成し、データを読み込みます。

処理の流れは、
既にある「CSVshtName+番号」のシートを削除
　　↓
１つ目のCSVファイルを読み込む
　　↓
出力用の「CSVshtName & 1」シートを作成
　　↓
CSVファイルのデータをシートに貼り付け
　　↓
２つ目のファイルがあれば読み込む。以下繰り返し。

シート削除の確認や、画面更新を止めて、最後に有効に戻しています。
標準モジュールに貼り付けます。当方win10、Excel2010です。
ご参考に。

Sub CSV2XLSX()
　Dim ws As Worksheet　　　　　　 '// ワークシート
　Dim fPath As String　　　　　　 '// ファイルのパス
　fPath = "N:\履歴\Work"
　Const CSVshtName = "CSV_Sheet"　'// CSV出力シート名

　Application.ScreenUpdating = False
　Application.DisplayAlerts = False

　'// 既にあるCSV出力用シートを削除
　For Each ws In Sheets
　　　If Left(ws.name, 9) = CSVshtName Then
　　　　ws.Delete
　　　End If
　Next

　'// CSVファイルを読む
　Dim queryTb As QueryTable

　Dim fExp As String　　　　 '// 拡張子
　Dim fName As String　　　　'// ファイルフルパス
　Dim idxCSVSheet As Integer '// CSVファイルの番号
　fExp = "*.csv"

　fName = Dir(fPath & "\" & fExp)
　While fName <> ""
　　idxCSVSheet = idxCSVSheet + 1
　　Worksheets.Add(After:=Worksheets(Worksheets.Count), Count:=1). _
　　　　　　　　　 name = CSVshtName & idxCSVSheet
　　Set ws = ActiveSheet
　　Set queryTb = ws.QueryTables.Add(Connection:="TEXT;" & _
　　　　　　　　　　 fPath & "\" & fName, _
　　　　　　　　　　 Destination:=ws.Range("A1")) '// CSVファイルを開く
　　With queryTb
　　　　.TextFilePlatform = 65001　　　　'// 文字コード
　　　　.TextFileParseType = xlDelimited '// 区切り文字
　　　　.TextFileCommaDelimiter = True　 '// カンマ区切り
　　　　.RefreshStyle = xlOverwriteCells '// 書き込む方式
　　　　.Refresh　　　　　　　　　　　　 '// データ表示

　　　　.Delete　　　　　　　　　　　　　'// CSVとの接続解除
　　End With

　　fName = Dir()
　Wend

　Application.DisplayAlerts = True
　Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます。感動的でした。マクロが動いた際には、思わず「おぉ！美しい！」と叫びました。本当にありがとうございます。

回答No.1

kurokuro_siro

こちらを参考にしてCSVの文字コードを変更します。
https://vbabeginner.net/vba%E3%81%A7utf-8%E3%81%AE%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%82%92shift-jis%E3%81%AB%E5%A4%89%E6%8F%9B%E3%81%99%E3%82%8B/