EXCELマクロ（CSVファイルの0落ち対策）

PC

2021.04.05

こんにちは。テレワークYです。

CSVファイルのデータをもらった時に、何も考えずにEXCELで開くと、先頭の0が消える場合があります。このまま保存したりすると、データが変わってしまってトラブルになります。

よくあるケースであると思いますので、例として、A列に6桁の社員番号がある場合に、先頭にアポストロフィーを付けたファイルを、一括して同じフォルダーに保存するサンプルを作成しました。

サンプルコード
解説

サンプルコード

前提として、Microsoft Scripting Runtimeに参照設定をしてください。

Option Explicit

Private Property Get SHEET_EMPLOYEE() As Worksheet
    Set SHEET_EMPLOYEE = ThisWorkbook.Sheets("社員番号CSV変換")
End Property

Private Property Get MY_FOLDER() As String
    MY_FOLDER = SHEET_EMPLOYEE.Range("A1").Value
End Property

Public Sub sub_ChangeEmployeeCode()

    Dim fso As New FileSystemObject
    Dim fle As File
    
    Set fso = New FileSystemObject
    
    For Each fle In fso.GetFolder(MY_FOLDER).Files
        If LCase(fso.GetExtensionName(fle.Name)) = "csv" Then
            Workbooks.Open Filename:=fle.Path
            With ActiveWorkbook
                .Sheets(1).Columns("A:A").NumberFormatLocal = "'000000"
                Application.DisplayAlerts = False
                .SaveAs Filename:=RANGE_FOLDER & "\output_" & fle.Name, FileFormat:=xlCSV, CreateBackup:=False
                .Close
                Application.DisplayAlerts = True
            End With
        Else
            'Do nothing
        End If
    Next fle

    Set fso = Nothing

End Sub

解説

変数の宣言を強制します。

Option Explicit

定数オブジェクトが無いので、Property Procedureで定義します。

Private Property Get SHEET_EMPLOYEE() As Worksheet
    Set SHEET_EMPLOYEE = ThisWorkbook.Sheets("社員番号CSV変換")
End Property

Private Property Get RANGE_FOLDER() As String
    RANGE_FOLDER = SHEET_EMPLOYEE.Range("A1").Value
End Property

先頭で変数を定義します。

Public Sub sub_ChangeEmployeeCode()

    Dim fso As New FileSystemObject
    Dim fle As File
    
    Set fso = New FileSystemObject

フォルダ内の任意のファイルすべてに対して処理実行します。

    For Each fle In fso.GetFolder(MY_FOLDER).Files

CSVファイルのかどうか判断します。

         If LCase(fso.GetExtensionName(fle.Name)) = "csv" Then

CSVファイルであれば、ファイルを開き、A列の書式を”000000”にして、ファイル名の先頭に”output_”を付けて保存します。

            Workbooks.Open Filename:=fle.Path
            With ActiveWorkbook
                .Sheets(1).Columns("A:A").NumberFormatLocal = "'000000"
                Application.DisplayAlerts = False
                .SaveAs Filename:=RANGE_FOLDER & "\output_" & fle.Name, FileFormat:=xlCSV, CreateBackup:=False
                .Close
                Application.DisplayAlerts = True
            End With

CSVファイル以外に対しては、処理を行いません。

        Else
            'Do nothing
        End If

ループを閉じて、FileSystemObjectを解放して終了します。

    Set fso = Nothing

End Sub