ファルダ・ファイル操作のためクラスモジュール「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
説明や使用方法は、以下を参照してください。