VBAちっぷす 「Util＿FileUtil」

Option Explicit

'
' 参照設定
'
' FSO      Microsoft Scripting Runtime

Dim fileCount As Long


' ファイル一覧取得メソッド
' filePathList : ファイルのパスを格納する配列
' rootPath : ルートディレクトリのパス
Public Function getFilePath(filePathList() As String, rootPath) As Long
  ' ファイルの数を初期化する。
  fileCount = 0
  
  ' ルートのフォルダオブジェクトを取得する。
  Dim root As folder
  Dim fso As New FileSystemObject
  Set root = fso.GetFolder(rootPath)
  
  Call getFilePathRecurcive(filePathList, root)
  
  ' ファイル数を返却する。
  getFilePath = fileCount
  
  Set fso = Nothing
End Function



' ファイル一覧取得メソッド(再帰)
Private Sub getFilePathRecurcive(filePathList() As String, parentFolder As folder)
  
  Dim folder As folder
  ' 子フォルダ
  For Each folder In parentFolder.SubFolders
    Call getFilePathRecurcive(filePathList, folder)
  Next folder
  
  ' 子ファイル
  Dim file As file
  For Each file In parentFolder.Files
    ' エクセルファイルのみ対象
    If (isMatchFileType(file.Name, "xlsx") = True Or isMatchFileType(file.Name, "xls") = True) Then
      ' リストに登録する。
      fileCount = fileCount + 1
      filePathList(fileCount) = file.Path
    End If
  Next file
End Sub



' フォルダ存在チェックメソッド
' True - 存在する。 False - 存在しない。
Public Function isFolderExists(folderPath As String) As Boolean
  If Dir(folderPath, vbDirectory) = "" Then
    isFolderExists = False
  Else
    isFolderExists = True
  End If
End Function



' 拡張子一致チェックメソッド
Public Function isMatchFileType(str As String, fileType As String) As Boolean
  If Right(str, Len(fileType)) = fileType Then
    isMatchFileType = True
  Else
    isMatchFileType = False
  End If
End Function

'
' テキストファイルをロードする。 (テキストファイル⇒Range型変数)
' destRange   : 出力先領域の左上の座標
' csvFilePath : 入力ファイルのパス
' delimiter   : 区切り文字
' isRTrim     : 空白をトリムするかどうか (True:する, False:しない)
'
Public Sub loadFile(destRange As Range, filePath As String, delimiter As String, isRTrim As Boolean)

  Dim text As String                ' 1行分のデータ
  Dim elements As Variant           ' 1行分のデータ(カンマ分割)
  Dim currentRow As Long            ' 現在の行番号
  Dim currentColumn As Long         ' カラム番号
    
  Open filePath For Input As #1
  currentRow = 0
  Do Until EOF(1)
    Line Input #1, text
    elements = Split(text, delimiter)
    For currentColumn = 0 To UBound(elements)
      If isRTrim = True Then
        destRange.Offset(currentRow, currentColumn).Value = RTrim(elements(currentColumn))
      Else
        destRange.Offset(currentRow, currentColumn).Value = elements(currentColumn)
      End If
    Next
    currentRow = currentRow + 1
  Loop
  Close #1
  
End Sub


'
' テキストファイルへ出力する。 (Range型変数⇒テキストファイル)
' destRange   : 入力元領域
' csvFilePath : 出力ファイルのパス
' appendMode  : 追加書き込みをするか。(True:する, False:しない)
' delimiter   : 区切り文字
' isRTrim     : 空白をトリムするかどうか (True:する, False:しない)
'
Public Sub writeFile(srcRange As Range, filePath As String, appendMode As Boolean, delimiter As String, isRTrim As Boolean)

  Dim text As String
  Dim element As String
  Dim y As Long                     ' 現在の行番号
  Dim x As Long                     ' カラム番号
        
  If appendMode Then
    Open filePath For Append As #1
  Else
    Open filePath For Output As #1
  End If
    
  With srcRange
  
    ' 1行ずつファイル出力をする。
    For y = 1 To .Rows.count
      text = ""
      For x = 1 To .Columns.count
        element = .Item(y, x).Value
        If isRTrim Then
          element = RTrim(element)
        End If
        If x <> .Columns.count Then
          text = text & element & delimiter
        Else
          text = text & element
        End If
      Next
      Print #1, text
    Next
  
  End With
  
  Close #1
  
End Sub