Excel VBAでフォルダやファイルを操作する関数集

概要

• Excel VBAで、フォルダやファイルを操作するためのコード集を作成しました。条件に当たるファイルのフルパスをすべて取得する関数など、利用すると便利です。

コードに関する動画

• 以下の動画でこのコードを使いました。

実行環境

以下の環境で動作確認をしました。

• Windows11でのExcel 2021

注意

• プログラムの実行については、すべて自己責任で行ってください。実行により発生した、いかなる直接的または間接的被害について、作者はその責任を負いません。

各コード（関数）について

今回ご紹介するコードは、「フォルダ操作に関すること」および「ファイル操作に関すること」の２つです。それぞれについて、目的に応じた関数を作成しました。

• フォルダ操作に関すること
  • 特定の親フォルダ内で、特定の名前がついたサブフォルダのフルパスリストを返す関数
  • フォルダ名を変更する関数
  • フォルダをコピーする関数
  • 新しいフォルダを作成する関数
  • フォルダを開く関数

• ファイル操作に関すること
  • 特定のフォルダ内で、特定の名前がついたファイルのフルパスリストを返す関数
  • ファイル名を変更する関数
  • ファイルをコピーする関数
  • ファイルに関する情報を取得する関数

実行例

• 以下のテスト用関数を参考にしてみてください。具体的なパス名などは、仮の値（"Your_Path_Here"、"Name_Here"）が入っているので、変更してください。

テスト用関数

Option Explicit

' GetFolderList関数のテスト
Sub TestGetFolderList()
    ' 指定フォルダ内の指定条件に合致するフォルダのリスト
    Dim folderList() As Variant
    ' 親フォルダのパス
    Dim ParentFolderPath As String
    ' フォルダ名の部分名
    Dim FolderPartName As String
    
    ' 親フォルダのパスを設定
    ParentFolderPath = "Your_Path_Here"
    
    ' フォルダ名を設定
    FolderPartName = "Name_Here"
    
    ' GetFolderList関数を呼び出してフォルダリストを取得
    folderList = GetFolderList(ParentFolderPath, FolderPartName)
    
    ' デバッグに出力
    ' Debug.Print "配列の上限: " & UBound(folderList)
    ' Debug.Print "配列の下限: " & LBound(folderList)

    Dim i As Long

    ' 配列のすべての要素をデバッグに出力
    For i = LBound(folderList) To UBound(folderList)
        Debug.Print "Index " & i & ": " & folderList(i)
    Next i
End Sub

' フォルダ名を変更するサブプロシージャのテスト
Sub TestChangeFolderName()
    ' 変更対象フォルダのフルパス
    Dim FolderFullPath As String
    ' 変更前のフォルダ名の部分名
    Dim BeforeName As String
    ' 変更後のフォルダ名の部分名
    Dim AfterName As String

    ' テスト用の変数に値を設定
    FolderFullPath = "Your_Path_Here"

    BeforeName = "Name_Here"
    AfterName = Format(Date, "yyyymmdd") & "_ Name_Here"

    ' フォルダ名を変更するサブプロシージャを呼び出し
    Call ChangeFolderName(FolderFullPath, BeforeName, AfterName)
End Sub

Sub TestCopyFolder()
    Dim SourcePath As String ' コピー元フォルダのパス
    Dim NewFolderPath As String ' コピー先フォルダのパス
    
    ' コピー元フォルダのパス
    SourcePath = "Your_Path_Here"

    ' コピー後のフォルダのフルパス
    NewFolderPath = "Your_Path_Here"

    ' テスト対象のサブプロシージャを呼び出し
    Call CopyFolder(SourcePath, NewFolderPath)
End Sub

Sub TestMakeFolder()
    ' テストする変数を定義
    Dim folderName As String
    
    ' 変数に値を設定
    folderName = "Your_Path_Here"

    ' テストする関数を呼び出し
    Call MakeFolder(folderName)
End Sub

Sub TestOpenFolder()
    ' テストする変数を定義
    Dim folderPath As String
    
    ' 変数に値を設定
    folderPath = "Your_Path_Here"

    ' テストする関数を呼び出し
    Call OpenFolder(folderPath)
End Sub

Sub TestGetFileList()
    ' テストする変数を定義
    Dim fileList() As Variant
    Dim ParentFolderPath As String
    Dim FilePartName As String
    Dim i As Long

    ' 親フォルダのパスを設定
    ParentFolderPath = "Your_Path_Here"

    ' ファイル名の部分名を設定
    FilePartName = "Name_Here"

    ' GetFileList関数を呼び出してファイルリストを取得
    fileList = GetFileList(ParentFolderPath, FilePartName)

    ' ファイルリストの要素数をデバッグに出力
    Debug.Print "Number of files: " & UBound(fileList) - LBound(fileList) + 1

    ' ファイルリストのすべての要素をデバッグに出力
    For i = LBound(fileList) To UBound(fileList)
        Debug.Print "Index " & i & ": " & fileList(i)
    Next i
End Sub

Sub TestChangeFileName()
    ' テストする変数を定義
    Dim FilePath As String
    Dim NewFileName As String

    ' ファイルのパスを設定
    FilePath = "Your_Path_Here"

    ' 新しいファイル名を設定
    NewFileName = Format(Date, "yyyymmdd") & "File_Name"

    ' ChangeFileNameサブプロシージャを呼び出してファイル名を変更
    Call ChangeFileName(FilePath, NewFileName)
End Sub

Sub TestCopyFile()
    ' テストする変数を定義
    Dim SourceFilePath As String
    Dim NewFileName As String

    ' コピー元のファイルパスを設定
    SourceFilePath = "Your_Path_Here"

    ' コピー先のファイルパスを設定
    NewFileName = "Your_Path_Here"

    ' CopyFileサブプロシージャを呼び出してファイルをコピー
    Call CopyFile(SourceFilePath, NewFileName)
End Sub

Sub TestGetFileInfo()
    ' テストする変数を定義
    Dim FilePath As String
    Dim InfoType As String
    Dim result As String

    ' ファイルのパスを設定
    FilePath = "Your_Path_Here"

    ' 取得する情報の種類を設定
    InfoType = "ファイル名"
    ' GetFileInfo関数を呼び出して結果を取得
    result = GetFileInfo(FilePath, InfoType)
    ' 結果をデバッグ
    Debug.Print InfoType & ": " & result

    ' テストする変数を再設定
    InfoType = "ディレクトリ名"
    ' GetFileInfo関数を呼び出して結果を取得
    result = GetFileInfo(FilePath, InfoType)
    ' 結果をデバッグ
    Debug.Print InfoType & ": " & result
    
    ' テストする変数を再設定
    InfoType = "拡張子なしファイル名"
    ' GetFileInfo関数を呼び出して結果を取得
    result = GetFileInfo(FilePath, InfoType)
    ' 結果をデバッグ
    Debug.Print InfoType & ": " & result

    ' テストする変数を再設定
    InfoType = "拡張子"
    ' GetFileInfo関数を呼び出して結果を取得
    result = GetFileInfo(FilePath, InfoType)
    ' 結果をデバッグ
    Debug.Print InfoType & ": " & result
End Sub
    

• 以下、フォルダやファイルを操作するための、汎用的に利用する関数をご紹介します。

汎用関数

Option Explicit
'------------フォルダに関すること------------------------------------------------------

' 特定の親フォルダ内で、特定の名前がついたサブフォルダのフルパスリストを返す関数
Function GetFolderList(ByVal ParentFolderPath As String, ByVal FolderPartName As String) As Variant
  ' ParentFolderPath: 親フォルダのパス
  ' FolderPartName: フォルダ名の部分名
  Dim fso As Object
  Dim folderList() As Variant ' フォルダリストの配列
  Dim i As Long
  i = 1 ' 配列のインデックス

  ' FileSystemObjectを作成
  Set fso = CreateObject("Scripting.FileSystemObject")

  Dim folderObject As Object
  Dim foundFolders As Boolean ' フォルダが見つかったかどうかを示すフラグ
  foundFolders = False

  For Each folderObject In fso.GetFolder(ParentFolderPath).SubFolders
    ' フォルダ名が指定条件に合致する場合
    If InStr(fso.GetBaseName(folderObject.Path), FolderPartName) <> 0 Then
      ' 配列のサイズを1増やし（ReDimによる変更）、既存のデータを保持（Preserve）
      ReDim Preserve folderList(1 To i)
      folderList(i) = folderObject.Path
      i = i + 1
      foundFolders = True
    End If
  Next

  ' FileSystemObjectを解放
  Set fso = Nothing

  ' フォルダが見つからなかった場合の処理
  If Not foundFolders Then
    Debug.Print "フォルダが見つかりません。"
    Stop ' 処理を停止
    End
  End If

  ' 結果の配列を返す
  GetFolderList = folderList
End Function


' フォルダ名を変更する関数
Function ChangeFolderName(ByVal FolderFullPath As String, ByVal BeforeName As String, ByVal AfterName As String)
  ' FolderFullPath: フォルダのフルパス
  ' BeforeName: 変更前のフォルダ部分名
  ' AfterName: 変更後のフォルダ部分名
  Dim fso As Object
  Dim NewFolderName As String
   
  ' FileSystemObjectを作成
  Set fso = CreateObject("Scripting.FileSystemObject")
   
  ' 変更前のフォルダ名を取得
  Dim CurrentFolderName As String
  CurrentFolderName = fso.GetFolder(FolderFullPath).Name
   
  ' 変更後のフォルダ名
  NewFolderName = Replace(CurrentFolderName, BeforeName, AfterName)
   
  ' フォルダ名を変更
  fso.GetFolder(FolderFullPath).Name = NewFolderName
   
  ' FileSystemObjectを解放
  Set fso = Nothing
   
  ' 変更後のフォルダ名を返す
  Debug.Print "変更後のフォルダ名: " & NewFolderName
End Function


' フォルダをコピーする関数
Function CopyFolder(ByVal CopyFromPath As String, ByVal CopyToPath As String)
  ' CopyFromPath: コピー元フォルダのパス
  ' CopyToPath:   コピー後のフォルダのフルパス
  Dim fso As Object
   
  ' コピー先のフォルダが存在しない場合
  If Dir(CopyToPath, vbDirectory) = "" Then
    ' FileSystemObjectを作成
    Set fso = CreateObject("Scripting.FileSystemObject")
     
    ' フォルダをコピー
    fso.CopyFolder CopyFromPath, CopyToPath
     
    ' FileSystemObjectを解放
    Set fso = Nothing
  Else
    ' コピー先のフォルダが既に存在する場合は何もしない
  End If
End Function



' 新しいフォルダを作成する関数
Function MakeFolder(ByVal folderName As String)
  ' FolderName: 作成するフォルダの名前
  ' フォルダが存在しないかどうかを確認
  If Dir(folderName, vbDirectory) = "" Then
    ' フォルダが存在しない場合は新しいフォルダを作成
    MkDir folderName
  Else
    ' フォルダが既に存在する場合は何もしない
  End If
End Function


' フォルダを開く関数
Function OpenFolder(ByVal folderPath As String)
  ' FolderPath: 開くフォルダのパス
  Dim shell As Object
   
  ' フォルダが存在するか確認
  If Dir(folderPath, vbDirectory) = "" Then
    Debug.Print "指定されたフォルダが存在しません: " & folderPath
    Stop ' 処理を停止
    End
  End If
   
  ' WScript.Shellオブジェクトを作成
  Set shell = CreateObject("WScript.Shell")
   
  ' フォルダを開く
  shell.Run folderPath
   
  ' WScript.Shellオブジェクトを解放
  Set shell = Nothing
End Function


'------------ファイルに関すること------------------------------------------------------

' 特定のフォルダ内で、特定の名前がついたファイルのフルパスリストを返す関数
Function GetFileList(ByVal folderPath As String, ByVal FilePartName As String) As Variant
  ' FolderPath: ファイルを検索するフォルダのパス
  ' FilePartName: ファイル名の部分名
  Dim fso As Object
  Dim fileList() As Variant ' ファイルリストの配列
  Dim i As Long
  i = 1 ' 配列のインデックス

  ' FileSystemObjectを作成
  Set fso = CreateObject("Scripting.FileSystemObject")

  Dim fileObject As Object
  Dim foundFiles As Boolean ' ファイルが見つかったかどうかを示すフラグ
  foundFiles = False

  For Each fileObject In fso.GetFolder(folderPath).Files
    ' ファイル名が指定条件に合致する場合
    If InStr(fso.GetFileName(fileObject.Path), FilePartName) <> 0 Then
      ' 配列のサイズを1増やし（ReDimによる変更）、既存のデータを保持（Preserve）
      ReDim Preserve fileList(1 To i)
      fileList(i) = fileObject.Path
      i = i + 1
      foundFiles = True
    End If
  Next

  ' FileSystemObjectを解放
  Set fso = Nothing

  ' ファイルが見つからなかった場合の処理
  If Not foundFiles Then
    Debug.Print "ファイルが見つかりません。"
    Stop ' 処理を停止
    End
  End If

  ' 結果の配列を返す
  GetFileList = fileList
End Function


' ファイル名を変更する関数
Function ChangeFileName(ByVal FilePath As String, ByVal NewFileName As String)
  ' FilePath: ファイルのフルパス
  ' NewFileName: 変更後のファイル名
  Dim fso As Object
  Dim targetFile As Object
   
  ' FileSystemObjectを作成
  Set fso = CreateObject("Scripting.FileSystemObject")
   
  ' 変更対象のファイルを取得
  Set targetFile = fso.GetFile(FilePath)
   
  ' ファイルが存在するか確認
  If targetFile Is Nothing Then
    Debug.Print "ファイルが存在しません。"
    Stop ' 処理を停止
    End
  Else
    ' ファイル名を変更
    targetFile.Name = NewFileName
  End If
   
  ' FileSystemObjectを解放
  Set fso = Nothing
End Function


' ファイルをコピーする関数
Function CopyFile(ByVal SourceFilePath As String, ByVal NewFilePath As String)
  ' SourceFilePath: コピー元ファイルのパス
  ' NewFilePath: コピー先ファイルのパス
  Dim response As Long
   
  ' コピー先に同名のファイルが存在するか確認
  If Dir(NewFilePath) <> "" Then
    ' ユーザーに確認メッセージを表示
    response = MsgBox("同名のファイルが存在します。" & vbCrLf & _
      "上書きしますか？", vbYesNo)
     
    ' Noが選択された場合は終了
    If response = vbNo Then Exit Function
  End If
   
  ' ファイルをコピー
  FileCopy SourceFilePath, NewFilePath
End Function


' ファイルに関する情報を取得する関数
Function GetFileInfo(ByVal FilePath As String, ByVal InfoType As String) As String
  ' FilePath: ファイルのパス
  ' InfoType: 取得する情報の種類
  Dim objFSO As Object
  Set objFSO = CreateObject("Scripting.FileSystemObject")
   
  ' ディレクトリ名を取得
  If InfoType = "ディレクトリ名" Then
    GetFileInfo = objFSO.GetParentFolderName(FilePath)
   
  ' ファイル名を取得
  ElseIf InfoType = "ファイル名" Then
    GetFileInfo = objFSO.GetFileName(FilePath)
   
  ' ファイル名（拡張子を除く）を取得
  ElseIf InfoType = "拡張子なしファイル名" Then
    GetFileInfo = objFSO.GetBaseName(FilePath)
   
  ' 拡張子が何か取得
  ElseIf InfoType = "拡張子" Then
    GetFileInfo = objFSO.GetExtensionName(FilePath)
   
  ' 不明な InfoType が指定された場合は空文字列を返す
  Else
    Debug.Print "未知の InfoType が指定されました: " & InfoType
    Stop ' 処理を停止
    End
  End If
   
  ' FileSystemObjectを解放
  Set objFSO = Nothing
End Function