ファルダ・ファイル操作のためクラスモジュール「FileObj」を作ってみた

タイトルのクラスモジュールは、以下です。クラスモジュールに、「FileObj」というオブジェクト名で格納しています。

Private Value As File           ' ファイルオブジェクト
Private mstrMessage As String   ' メッセージ

' コンストラクタ
Private Sub Class_Initialize()
    mstrMessage = ""
End Sub

'************************************************************
' プロパティ名:Message
' 概要    :メッセージ
'************************************************************
Public Property Get Message() As String
    Message = mstrMessage
End Property
Private Property Let Message(ByVal strMsg As String)
    mstrMessage = strMsg
End Property

'************************************************************
' メソッド名:CreateFolder
' 概要   :フォルダを作成する
' パラメータ:[strFolderPath] - フォルダパス
' 戻り値  :作成できたらTrue、そうでなければFalse
'************************************************************
Public Function CreateFolder(ByVal strFolderPath As String) As Boolean
    CreateFolder = False

    On Error Resume Next

    Dim blnExists As Boolean
    blnExists = ExistFolder(strFolderPath) ' フォルダが存在するか確認
    If blnExists Then
        CreateFolder = True
        Exit Function
    End If

    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    objFSO.CreateFolder strFolderPath

    Set objFSO = Nothing

    If Err.Number <> 0 Then
        Message = CStr(Err.Number) & ":" & Err.Description
        Err.Clear
        Exit Function
    End If

    On Error GoTo 0

    CreateFolder = True
End Function

'****************************************************************
'* フォルダが存在するかどうかを確認する関数
'* myFolder: 確認するフォルダのパス
'* 戻り値: フォルダが存在すればTrue、存在しなければFalse
Public Function ExistFolder(myFolder As String) As Boolean
    On Error GoTo ErrHdl        ' エラーハンドリングを設定
    ExistFolder = False         ' 初期値としてFalseを設定
    With New FileSystemObject   ' FileSystemObjectを新規作成
        .GetFolder (myFolder)   ' 指定されたフォルダが存在するか確認
    End With
    ExistFolder = True          ' フォルダが存在すればTrueを設定
    Exit Function               ' 関数を終了
    
ErrHdl:                         ' エラーハンドラ
    ExistFolder = False         ' フォルダが存在しない場合はFalseを設定
End Function

'****************************************************************
'* ファイルが存在するかどうかを確認する関数
'* filePath:フルパスのファイル名
'* 戻り値: ファイルが存在すればTrue、存在しなければFalse
Public Function ExistFile(filePath As String) As Boolean
    On Error GoTo ErrHdl        ' エラーハンドリングの設定
    ExistFile = False           ' 初期値をFalseに設定
    
    ' FileSystemObjectを使用してファイルを取得し、存在確認
    With New FileSystemObject
        .GetFile (filePath)     ' 指定したファイルを取得(存在しない場合はエラー)
    End With
    
    ExistFile = True            ' ファイルが存在する場合はTrueに設定
    Exit Function               ' 関数を終了

ErrHdl:  ' エラーハンドラ
    ExistFile = False           ' エラーが発生した場合はFalseに設定
End Function

'****************************************************************
'* Valueの拡張子を返す。20230224
Public Property Get Extension() As String
    With New FileSystemObject
        Extension = .GetExtensionName(Value)
    End With
End Property

'****************************************************************
'* ファイルのフルパスから、ファイルを取得。20230224
Public Property Let Name(ByVal vName As String)
    ' 移動元のファイルの確認
    If Not ExistFile(vName) Then
        MsgBox "移動元のファイルが確認できませんでした"
        Exit Property
    End If
    
    With New FileSystemObject
        Set Value = .GetFile(vName)
    End With
End Property

Public Property Get Name() As String
    If Value Is Nothing Then
        Name = ""
    Else
        Name = Value.Name
    End If
End Property

'****************************************************************
'* ファイルの移動。20230224
'* myDestination:移動先のパス
Public Sub Move(ByVal myDestination As String)
    Value.Move myDestination & "\"
End Sub

'****************************************************************
'* ファイル名変更。20230227
'* myFileRename:変更後のファイル名
Public Sub Rename(ByVal myFileRename As String)
    Value.Name = myFileRename
End Sub

説明や使用方法は、以下を参照してください。

ExistFolder関数

ExistFile関数

CreateFolder関数の使用例

MoveとExistFolder関数とExistFile関数の使用例

RenameとExistFolder関数とExistFile関数の使用例

Follow me!