今日、たくさんのcsvファイルを一つずつ開いて、マクロ有効ブック.xlsmとして保存する作業をはじめました。大変手間がかかることがわかったので、エクセルのVBAマクロで一括変換できないかChatGPTに相談してみました。結果は、
「VBAでフォルダ内の複数CSVを一括で.xlsm（マクロ有効ブック）に変換できます。」ということで、VBAマクロを作ってくれたので紹介します。
マクロの使い方は以下のとおりです（概要）
１）Excelで空ブックを開く → Alt + F11 → 「挿入」→「標準モジュール」。
２）下のコードを貼り付けて保存（このブックは .xlsm で保存します）。
３）Alt + F8 → BatchConvertCsvToXlsm （マクロの名）を実行。
４）ダイアログで変換元フォルダ（CSVがあるフォルダ：新規にフォルダを作成するのがおすすめです）をきいてくるので指定します。
５）次に、出力先フォルダ（.xlsmを書き出すフォルダ：新規に作成するのがおすすめです）をきいてくるので指定します。
しばらくまっていると、すべてのCSVファイルが.xlsmファイルになって出力先フォルダにできあがります。これは便利なマクロです。
マクロは以下のとおりです。
Option Explicit
Sub BatchConvertCsvToXlsm()
Dim srcFolder As String, dstFolder As String
Dim fd As FileDialog
Dim fso As Object, f As Object, folder As Object
Dim wb As Workbook
Dim baseName As String, outPath As String
Dim cntOk As Long, cntNg As Long
‘ フォルダ選択（変換元）
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = “CSVのあるフォルダを選んでください”
If .Show <> -1 Then Exit Sub
srcFolder = .SelectedItems(1)
End With
‘ フォルダ選択（出力先）
With fd
.Title = “出力先フォルダ（.xlsm）を選んでください”
If .Show <> -1 Then Exit Sub
dstFolder = .SelectedItems(1)
End With
If Right$(srcFolder, 1) <> “\” Then srcFolder = srcFolder & “\”
If Right$(dstFolder, 1) <> “\” Then dstFolder = dstFolder & “\”
Set fso = CreateObject(“Scripting.FileSystemObject”)
If Not fso.FolderExists(srcFolder) Then
MsgBox “変換元フォルダが見つかりません: ” & srcFolder, vbExclamation
Exit Sub
End If
If Not fso.FolderExists(dstFolder) Then
MsgBox “出力先フォルダが見つかりません: ” & dstFolder, vbExclamation
Exit Sub
End If
Set folder = fso.GetFolder(srcFolder)
‘ 高速化
Dim prevScr As Boolean, prevDisp As Boolean, prevCalc As XlCalculation, prevEvt As Boolean
prevScr = Application.ScreenUpdating
prevDisp = Application.DisplayAlerts
prevCalc = Application.Calculation
prevEvt = Application.EnableEvents
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
On Error GoTo CLEANUP
Dim ext As String
For Each f In folder.Files
ext = LCase$(fso.GetExtensionName(f.Path))
If ext = “csv” Then
On Error Resume Next
‘ ★基本は自動判定で開く（UTF-8/BOM付き等はExcelが自動解釈することが多い）
Set wb = Workbooks.Open(Filename:=f.Path)
If Err.Number <> 0 Or wb Is Nothing Then
‘ 開けなかった場合は明示的区切り指定（カンマ）で再トライ
Err.Clear
On Error GoTo 0
Workbooks.OpenText _
Filename:=f.Path, _
DataType:=xlDelimited, _
Comma:=True, _
Local:=True ‘ ローカル区切り/エンコーディングの助け
Set wb = ActiveWorkbook
Else
On Error GoTo 0
End If
If Not wb Is Nothing Then
baseName = fso.GetBaseName(f.Path)
outPath = dstFolder & baseName & “.xlsm”
‘ 既存があれば上書き（DisplayAlerts=Falseのため確認なし）
wb.SaveAs Filename:=outPath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
wb.Close SaveChanges:=False
cntOk = cntOk + 1
Else
cntNg = cntNg + 1
End If
End If
Next f
CLEANUP:
Application.ScreenUpdating = prevScr
Application.DisplayAlerts = prevDisp
Application.Calculation = prevCalc
Application.EnableEvents = prevEvt
If Err.Number <> 0 Then
MsgBox “処理中にエラーが発生しました: ” & Err.Description & vbCrLf & _
“成功: ” & cntOk & ” 件 / 失敗: ” & cntNg & ” 件”, vbExclamation
Else
MsgBox “変換完了” & vbCrLf & _
“成功: ” & cntOk & ” 件 / 失敗: ” & cntNg & ” 件”, vbInformation
End If
End Sub
上のコードをコピペするだけで動くと思います。動かないときはChatGPTにコードをいれてきいてみてください。ChatGPTが書いてきた注意点もペーストしておきます。
注意点：
・区切り文字がタブやセミコロンのCSV/TSVの場合は、Workbooks.OpenText の引数を変更してください（例：Tab:=True、Semicolon:=True）。
・文字化け対策：UTF-8(BOMなし)などで文字化けする場合は、OpenText に Origin:=65001 を追加して試してください。