[Excel VBA] CSV出力 | VBA プログラミングで社内アプリ開発

ExcelをCSVで保存するのは、大抵何か別のシステムにデータを取り込む時とかによくやるんだけど、わざわざ毎回名前を付けて保存でファイルの種類をCSVを選択して保存するのは少し面倒だよね。

それが例えば週2、3回とか割とよくやる作業だとしたら、今後は是非ボタン一つでCSV保存出来るようにしたらいいと思うよ。

それではコードを教えます。

まずはデータは下記のような感じで、ボタンもこんな感じで配置してください。

データの列は増減しても大丈夫なようにしてあるよ。

次に今回のコードでは参照設定というのを行う必要があるよ。参照設定というのは簡単に言えば、実行するための部品(DLLというファイル)をプログラムから呼び出せるようにするためで、今回はCSVファイルを操作するためにMicrosoft Scripting Runtimeというのを追加するよ。

メニューバーのツールから参照設定を選択して、下の方にスクロールしてMicrosoft Scriptiong Runtimeにチェックを付けるだけだよ。

これにチェックを入れないとプログラム実行時にエラーになるから、必ず設定する必要があるよ。

それではコードはこちら！

Option Explicit

Public WSH As Object
Public FSO As Object

Const KeyColumn As Integer = 1
Const CSVFilename As String = "カスタマー情報"

Sub CSVConvert_Click()

    Dim CSVFileFullPath As String
    Set WSH = CreateObject("Wscript.Shell")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    CSVFileFullPath = WSH.SpecialFolders("Desktop") & "\" & CSVFilename & ".csv"

    Call SetCSV(CSVFileFullPath)
    Call WriteCSV(CSVFileFullPath)

    MsgBox (CSVFilename & "がデスクトップに作成されました。")

End Sub

Sub SetCSV(CSVFileFullPath As String)

    If FSO.FileExists(CSVFileFullPath) Then
        FSO.DeleteFile (CSVFileFullPath)
    End If
    
    FSO.CreateTextFile (CSVFileFullPath)

End Sub

Sub WriteCSV(CSVFileFullPath As String)

    Dim intFF As Integer            ' FreeFile値
    Dim TS As TextStream            ' TextStream
    Dim RowCount As Integer
    
' 指定ファイルをOPEN(出力モード)
    Set TS = FSO.OpenTextFile(CSVFileFullPath, 2, True)
    
    For RowCount = 1 To getMaxRow()
        If getValue(RowCount) <> "" Then
            TS.WriteLine getValue(RowCount)
        End If
    Next
    TS.Close
    
End Sub

Function getValue(RowNum)

    Dim SetStr As String
    Dim ColCount As Integer
    
    getValue = ""
    
    For ColCount = 1 To getMaxColumn
        SetStr = SetStr & Replace(ActiveSheet.Cells(RowNum, ColCount), ",", "") & ","
    Next

    getValue = Left(SetStr, Len(SetStr) - 1)

End Function

Function getMaxRow()

    Dim i As Integer
    i = 2
    
    Do Until ActiveSheet.Cells(i, KeyColumn) = ""
        i = i + 1
    Loop
    
    getMaxRow = i - 1

End Function

Function getMaxColumn()

    Dim i As Integer
    i = 1
    
    '1列目から右へ1セルずつ移動して空白の箇所まで
    Do Until ActiveSheet.Cells(1, i) = ""
        i = i + 1
    Loop
    
    getMaxColumn = i - 1

End Function

ボタンを押すと、エクセル上のデータがそのままCSVとしてデスクトップに保存されます。

ソースコードを張り付けたあと、ボタンを配置して、実行されるプログラムに「CSVConvert_Click」を選択してね。

内容は単純で、1番上の行から、右に1セルずつデータを拾って、データの最後にカンマをつけて繋げていって、ファイルに出力していきます。

これはエクセルの情報をただそのままCSVに出力しているだけだけど、少し工夫を凝らせばエクセルの情報に対して何か変換をかけてCSVに出力するようなこともできるよ。色々試してみてね！