csv作成マクロ

```
Sub ConvertExcelToCSV()
    Dim folderPath As String
    Dim fileName As String
    Dim workbook As Workbook
    Dim sheet As Worksheet
    Dim csvPath As String
    Dim fso As Object

    ' マクロが保存されているディレクトリを取得
    folderPath = ThisWorkbook.Path
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    ' ファイル検索用
    fileName = Dir(folderPath & "*.xls*")
    
    ' FileSystemObjectの準備
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 対象ディレクトリにファイルがない場合
    If fileName = "" Then
        MsgBox "マクロ実行ディレクトリにExcelファイルがありません。", vbExclamation
        Exit Sub
    End If
    
    ' Excelファイルごとに処理
    Do While fileName <> ""
        ' マクロファイル（ThisWorkbook）はスキップ
        If fileName <> ThisWorkbook.Name Then
            Set workbook = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
            
            ' 各シートをCSVに変換
            For Each sheet In workbook.Sheets
                ' CSVファイルの保存パスを指定
                csvPath = folderPath & sheet.Name & ".csv"
                
                ' 既存のファイルがあれば削除
                If fso.FileExists(csvPath) Then
                    fso.DeleteFile csvPath, True ' True: 削除の確認をしない
                End If
                
                ' シートを一時的にCSVで保存
                sheet.Copy
                With ActiveWorkbook
                    .SaveAs Filename:=csvPath, FileFormat:=xlCSVUTF8
                    .Close SaveChanges:=False
                End With
            Next sheet
            
            ' Excelファイルを閉じる
            workbook.Close SaveChanges:=False
        End If
        
        fileName = Dir() ' 次のファイルへ
    Loop
    
    MsgBox "全てのExcelファイルをCSVに変換しました。", vbInformation
End Sub

```


```
Sub ConvertExcelToCSV()
    Dim folderPath As String
    Dim fileName As String
    Dim workbook As Workbook
    Dim sheet As Worksheet
    Dim tempCsvPath As String
    Dim finalCsvPath As String
    Dim fso As Object

    ' マクロが保存されているディレクトリを取得
    folderPath = ThisWorkbook.Path
    If Right(folderPath, 1) <> "\\" Then folderPath = folderPath & "\\"

    ' ファイル検索用
    fileName = Dir(folderPath & "*.xls*")

    ' FileSystemObjectの準備
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' 対象ディレクトリにファイルがない場合
    If fileName = "" Then
        MsgBox "マクロ実行ディレクトリにExcelファイルがありません。", vbExclamation
        Exit Sub
    End If

    ' Excelファイルごとに処理
    Do While fileName <> ""
        ' マクロファイル（ThisWorkbook）はスキップ
        If fileName <> ThisWorkbook.Name Then
            Set workbook = Workbooks.Open(folderPath & fileName, ReadOnly:=True)

            ' 各シートをCSVに変換
            For Each sheet In workbook.Sheets
                ' ファイル名に無効な文字を除去
                Dim sanitizedSheetName As String
                sanitizedSheetName = Replace(sheet.Name, "/", "_")
                sanitizedSheetName = Replace(sanitizedSheetName, "\", "_")
                sanitizedSheetName = Replace(sanitizedSheetName, "?", "_")
                sanitizedSheetName = Replace(sanitizedSheetName, "*", "_")

                ' 一時的なCSVファイルの保存パス
                tempCsvPath = folderPath & sanitizedSheetName & "_temp.csv"
                finalCsvPath = folderPath & sanitizedSheetName & ".csv"

                ' 既存のファイルがあれば削除
                If fso.FileExists(finalCsvPath) Then
                    On Error Resume Next
                    fso.DeleteFile finalCsvPath, True
                    On Error GoTo 0
                End If

                ' シートを一時的にCSVで保存
                sheet.Copy
                On Error Resume Next
                With ActiveWorkbook
                    .SaveAs Filename:=tempCsvPath, FileFormat:=xlCSVUTF8
                    .Close SaveChanges:=False
                End With
                On Error GoTo 0

                ' BOMなしUTF-8で再保存
                If fso.FileExists(tempCsvPath) Then
                    Call SaveAsUtf8WithoutBOM(tempCsvPath, finalCsvPath)

                    ' 一時ファイルを削除
                    On Error Resume Next
                    fso.DeleteFile tempCsvPath, True
                    On Error GoTo 0
                Else
                    MsgBox "一時CSVファイルの作成に失敗しました: " & tempCsvPath, vbExclamation
                End If
            Next sheet

            ' Excelファイルを閉じる
            workbook.Close SaveChanges:=False
        End If

        fileName = Dir() ' 次のファイルへ
    Loop

    MsgBox "全てのExcelファイルをCSVに変換しました。", vbInformation
End Sub

Sub SaveAsUtf8WithoutBOM(tempPath As String, finalPath As String)
    Dim stream As Object
    Dim fso As Object
    Dim text As String

    ' FileSystemObjectの準備
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' 一時ファイルの内容を読み込み
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2 ' テキストモード
    stream.Charset = "UTF-8"
    stream.Open
    stream.LoadFromFile tempPath
    text = stream.ReadText
    stream.Close

    ' BOMなしUTF-8で再保存
    stream.Type = 2 ' テキストモード
    stream.Charset = "UTF-8"
    stream.Open
    stream.WriteText text
    stream.Position = 3 ' BOMをスキップ
    stream.SaveToFile finalPath, 2 ' 新しいファイルに保存
    stream.Close

    Set stream = Nothing
    Set fso = Nothing
End Sub
```