LoginSignup
0
2

More than 3 years have passed since last update.

エクセルのCSV化マクロ

Last updated at Posted at 2020-06-02
  • 複数ファイル同時に変換
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

'再帰
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)

0
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
2