エクセルのCSV化マクロ

• 複数ファイル同時に変換

Sub csv()
     Dim OpenFileName As Variant
     Dim target As Variant
     Dim Findpos As Long

     Application.screenUpdating = False

     OpenFileName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xls?", MultiSelect:=True)
     If IsArray(OpenFileName) Then
         For Each target In OpenFileName
            Workbooks.Open target
            
            'ドットの位置取得　ファイル名取得用
            Findpos = InStrRev(ActiveWorkbook.Name, ".")

            '元のブックと同じ階層に出力
            ActiveWorkbook.SaveAs _
            Filename:=ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, Findpos - 1) & ".csv", _
               FileFormat:=xlCSV
       
            ActiveWorkbook.Close SaveChanges:=False
         Next target
     Else
        MsgBox "キャンセルされました"
     End If
　　　Application.ScreenUpdating = True
End Sub

• 指定フォルダ以下を再帰的に変換
• Microsoft Scripting Runtime参照設定が必要
  https://blog.goo.ne.jp/office_y/e/da9389b88ab88de9a92150e78544313e

'再帰
Sub saiki()
    Dim objFSO As FileSystemObject
  
    Dim Selectfolder As Variant

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
        Selectfolder = .SelectedItems(1)
        End If
    End With
    
    
    'FileSystemObjectのインスタンスの生成
    Set objFSO = New FileSystemObject
    Call GetDirFiles(objFSO.GetFolder(Selectfolder))
    'オブジェクトの解放
    Set objFSO = Nothing
End Sub

Sub GetDirFiles(ByVal objFolder As Folder)
    Dim objFolderSub As Folder
    Dim objFile As File
    Dim Findpos As Long
    
    
    'サブフォルダの取得
    For Each objFolderSub In objFolder.SubFolders
        Call GetDirFiles(objFolderSub)
    Next
    'ファイルの取得
    For Each objFile In objFolder.Files
            Workbooks.Open objFile.Path
            
            'ドットの位置取得　ファイル名取得用
            Findpos = InStrRev(ActiveWorkbook.Name, ".")
            
                '元のブックと同じ階層に出力
                ActiveWorkbook.SaveAs _
                Filename:=ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, Findpos - 1) & ".csv", _
                   FileFormat:=xlCSV
          
            ActiveWorkbook.Close SaveChanges:=False
            
    Next
    'オブジェクトの解放
    Set objFolderSub = Nothing
    Set objFile = Nothing
End Sub

FileSystemObject
「ツール」→「参照設定」「Microsoft Scripting Runtime」にチェック。

参照設定しない場合、
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

ADODB.Stream
参照設定で、「Microsoft ActiveX Data Objects 2.8 Library」にチェック。

参照設定しない場合、
Dim adoSt As Object
Set adoSt = CreateObject(ADODB.Stream)