Option Explicit
' a late binding wrapper class for FSO Files
'
Private objFile As Object
' *****************************************************************************
Private Sub Class_Terminate()
Set objFile = Nothing
End Sub
' *****************************************************************************
Public Function Init(FilePath As String) As clsFSOFile
On Error GoTo err_handle
Dim objFSO As Object
Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(FilePath)
Set objFSO = Nothing
exit_err:
Set Init = Me
Exit Function
err_handle:
Set objFile = Nothing
Resume exit_err
End Function
' *****************************************************************************
Public Function DateLastModified() As Date
DateLastModified = objFile.DateLastModified
End Function
' *****************************************************************************
Public Function DateCreated() As Date
DateCreated = objFile.DateCreated
End Function
' *****************************************************************************
Public Function Path() As String
Path = objFile.Path
End Function
' *****************************************************************************
Public Function DateLastAccessed() As Date
DateLastAccessed = objFile.DateLastAccessed
End Function
' *****************************************************************************
Public Function name() As String
name = objFile.name
End Function
' *****************************************************************************
Public Function ParentFolder() As clsFSOFolder
Dim objFolder As clsFSOFolder
Set objFolder = New clsFSOFolder
Set ParentFolder = objFolder.Init(objFile.ParentFolder)
Set objFolder = Nothing
End Function
' *****************************************************************************
Public Function Size() As Long
Size = objFile.Size
End Function
' *****************************************************************************
Public Function FileType() As String
FileType = objFile.Type
End Function
' *****************************************************************************
Public Function Move(Destination As String, _
Optional Overwrite As Boolean = True) As Boolean
On Error GoTo err_handle
If VBA.Right$(Destination, 1) <> "\" Then Destination = Destination & "\"
objFile.Move Destination & Me.name
Move = True
exit_err:
Exit Function
err_handle:
Select Case Err.Number
Case 58 ' enmError.errFileExists
If Overwrite Then
objFile.Copy Destination, Overwrite
objFile.Delete
End If
Case Else
Move = False
End Select
Resume exit_err
End Function
' *****************************************************************************
Public Function Extension() As String
Dim strName As String
Dim lngPos As Long
strName = Me.name
lngPos = VBA.InStrRev(strName, ".")
Select Case lngPos
Case Is > 0
Extension = VBA.LCase$(VBA.Mid$(strName, lngPos + 1, VBA.Len(strName)))
Case Else
Extension = VBA.vbNullString
End Select
End Function
' *****************************************************************************
Public Function Exists() As Boolean
Exists = Not (objFile Is Nothing)
End Function
' *****************************************************************************
Public Function Delete() As Boolean
' returns true if successful, false if not. this method will not return
' any errors if the file does not exist
On Error Resume Next
objFile.Delete
Delete = Not VBA.CBool(Err.Number)
Err.Clear
Set objFile = Nothing
End Function
