VBAちっぷす 「業務系＿エクセル⇒csv変換」

エクセルに記載されたデータをcsv出力する。

前提条件
・ディレクトリ「INPUT_DATA」に対象エクセルファイルを格納する。
・デイレクトリ「OUTPUT_DATA」を用意する。

・標準モジュールの追加が必要
CalcTimer
FileUtil
ProcessLog

以下ソースコード

vba

Option Explicit

Const INPUT_ROOT_FILE_PATH = "★INPUT_DATA★"
Const OUTPUT_ROOT_FILE_PATH = "★OUTPUT_DATA★"


' エントリ関数
Public Sub Main()

  ' 初期化処理を実行する。
  Call initializeApplication

  ' 処理対象ファイルの最大数
  Const FILE_LIST_MAX As Long = 10000
  
  ' ファイルパスリスト
  Dim filePathList(FILE_LIST_MAX) As String

  ' 処理対象のルートパス
  Dim rootPath As String
  rootPath = INPUT_ROOT_FILE_PATH
  
  ' ファイルパスリストを取得する。
  Dim fileCount As Long
  fileCount = FileUtil.getFilePath(filePathList, rootPath)
    
  ' 各ブックごとの処理を実行する。
  Dim i As Long
  For i = 1 To fileCount
    Call processPerWorkBook(filePathList(i))
    Call ProcessLog.WriteLog("ファイル「 " & filePathList(i) & " をcsvファイルへ出力しました｡ ")
    Application.StatusBar = "[" & i & "/" & fileCount & "ファイル完了]"
  Next
  
  ' 終了処理を実行する。
  Call finalizeApplication
    
End Sub





' 初期化処理
Private Sub initializeApplication()
  ProcessLog.InitLog
  
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Application.StatusBar = ""

End Sub






' 終了処理
Private Sub finalizeApplication()

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  Application.StatusBar = ""

End Sub







' 1ブック当たりの処理を記載する。
Sub processPerWorkBook(filePath As String)
  
  Dim currentWorkBook As Workbook
  Dim currentWorkSheet As Worksheet
  Set currentWorkBook = Workbooks.Open(filePath)
  Set currentWorkSheet = currentWorkBook.Sheets(1)
  
  Call processPerWorkSheet(currentWorkSheet)
  
  currentWorkBook.Close
  
End Sub






' 1ワークシート当たりの処理を記載する。
Sub processPerWorkSheet(targetSheet As Worksheet)

  Const POS_TABLE_NAME = "B1"     ' テーブル名の座標
  Const POS_HEADER_BEGIN = "A3"   ' ヘッダーの開始座標
  Const POS_DATA_BEGIN = "A6"     ' データの開始座標

  Dim headerRange As Range
  Dim dataRange As Range
  
  With targetSheet
  
  ' テーブル名を取得する。
  Dim tableName As String
  tableName = .Range(POS_TABLE_NAME)

  ' ヘッダーを領域を設定する。
  Dim columnCount As Long
  columnCount = getColumnCount(.Range(POS_HEADER_BEGIN))
  Set headerRange = .Range _
                      (.Range(POS_HEADER_BEGIN), _
                       .Range(POS_HEADER_BEGIN).Offset(0, columnCount - 1) _
                      )

  ' データ領域を設定する。
  Dim dataCount As Long
  dataCount = getDataCount(.Range(POS_DATA_BEGIN))

  Set dataRange = targetSheet.Range _
                    (.Range(POS_DATA_BEGIN), _
                     .Range(POS_DATA_BEGIN).Offset(dataCount - 1, columnCount - 1) _
                    )
                  
  ' csvファイルへ出力する。
  Dim csvFilePath As String
  csvFilePath = OUTPUT_ROOT_FILE_PATH + "/" + tableName + ".csv"
  Call FileUtil.writeFile(headerRange, csvFilePath, False, ",", False) ' 新規書き込み
  Call FileUtil.writeFile(dataRange, csvFilePath, True, ",", False)  ' 追加書き込み
 
  End With

End Sub


' カラム数を取得する。(右方向への走査)
Function getColumnCount(r As Range) As Long

  Dim count As Long
  Const CHAR_EMPTY = ""
  count = 0
  
  ' 念のため空白文字を取り除いて判定する。
  Do While (Trim(r.Offset(0, count)) <> CHAR_EMPTY)
    count = count + 1
  Loop
  getColumnCount = count

End Function

' データ数を取得する。(下方向への走査)
Function getDataCount(r As Range) As Long

  Dim count As Long
  Const CHAR_EMPTY = ""
  count = 0
  
  ' 念のため空白文字を取り除いて判定する。
  Do While (Trim(r.Offset(count, 0)) <> CHAR_EMPTY)
    count = count + 1
  Loop
  getDataCount = count
End Function