csv作成マクロ2

Sub ExportSheetsToCSV()
    Dim FileSystem As Object
    Dim Folder As Object
    Dim File As Object
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim CsvFileName As String
    Dim SavePath As String
    Dim TxtFile As Object
    Dim DataRow As Range
    Dim DataText As String

    ' マクロが保存されたディレクトリを取得
    SavePath = ThisWorkbook.Path

    ' ファイルシステムオブジェクトを作成
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    Set Folder = FileSystem.GetFolder(SavePath)

    ' フォルダ内の各ファイルをチェック
    For Each File In Folder.Files
        If FileSystem.GetExtensionName(File.Name) = "xlsx" Or FileSystem.GetExtensionName(File.Name) = "xlsm" Then
            Set wb = Workbooks.Open(File.Path)
            
            ' 各シートをCSVにエクスポート
            For Each ws In wb.Sheets
                CsvFileName = ws.Cells(1, 1).Value
                
                ' A1セルが空白ならスキップ
                If CsvFileName <> "" Then
                    CsvFileName = SavePath & "\" & CsvFileName & ".csv"

                    ' テキストファイルを作成
                    Set TxtFile = FileSystem.CreateTextFile(CsvFileName, True, False) ' FalseはUTF-8 (BOMなし)

                    ' シートのデータを1行ずつ書き込み
                    For Each DataRow In ws.UsedRange.Rows
                        DataText = ""
                        For Each Cell In DataRow.Cells
                            DataText = DataText & ",""" & Replace(Cell.Value, """", """""") & """"
                        Next Cell
                        DataText = Mid(DataText, 2) ' 最初のカンマを削除
                        TxtFile.WriteLine DataText
                    Next DataRow

                    TxtFile.Close
                End If
            Next ws

            wb.Close SaveChanges:=False
        End If
    Next File

    MsgBox "すべてのシートをCSVにエクスポートしました。"
End Sub