Option Explicit
' a late binding wrapper class for FSO Folder object
'
Private objFold As Object
Private WithEvents objFiles As clsFSOFiles
Private WithEvents objFolders As clsFSOFolders
Private lngSize As Currency
Private lngFileCount As Long
Public Event FileIndexed(FSOFile As clsFSOFile)
Public Event FolderIndexed(FSOFolder As clsFSOFolder)
' *****************************************************************************
Private Sub Class_Terminate()
Set objFolders = Nothing
Set objFiles = Nothing
Set objFold = Nothing
End Sub
' *****************************************************************************
Public Function Init(FolderPath As String) As clsFSOFolder
On Error GoTo err_handle
Dim objFSO As Object
Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")
Set objFold = objFSO.GetFolder(VBA.Trim$(FolderPath))
Set objFSO = Nothing
Me.Changed
exit_err:
Set Init = Me
Exit Function
err_handle:
Set objFold = Nothing
Resume exit_err
End Function
' *****************************************************************************
Public Function Create(FolderPath As String, _
Optional RecursiveAttempts As Integer = 100) As clsFSOFolder
' creates the file if it doesn't already exist
Dim strParent As String
Select Case Me.Init(FolderPath).Exists Or (RecursiveAttempts = 0)
' path doesn't exist - attempt to create the parent directory
Case False
' strip off final slash
If VBA.Right$(FolderPath, 1) = "\" Then FolderPath = VBA.Left$(FolderPath, VBA.Len(FolderPath) - 1)
' get the parent directory
strParent = VBA.Left$(FolderPath, VBA.InStrRev(FolderPath, "\"))
' does the parent directory exist?
Select Case Me.Init(strParent).Exists
' create a new FSO and create the directory
Case True
Set Create = FSOCreate(FolderPath)
' recursively call create to create the parent
Case False
Me.Create strParent, RecursiveAttempts - 1
Set Create = FSOCreate(FolderPath)
End Select
' path exists - return reference to FSO Object
Case True
Set Create = Me
End Select
End Function
' *****************************************************************************
Private Function FSOCreate(FolderPath As String) As clsFSOFolder
On Error Resume Next
Dim objFSO As Object
Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")
objFSO.CreateFolder FolderPath
Set objFSO = Nothing
Set FSOCreate = Me.Init(FolderPath)
End Function
' *****************************************************************************
Public Function DateCreated() As Date
DateCreated = objFold.DateCreated
End Function
' *****************************************************************************
Public Function Path() As String
Const acSLASH As String = "\"
Dim strReturn As String
strReturn = objFold.Path
Select Case VBA.Right$(strReturn, 1)
Case Is <> acSLASH
Path = strReturn & acSLASH
Case Else
Path = strReturn
End Select
End Function
' *****************************************************************************
Public Function DateLastAccessed() As Date
DateLastAccessed = objFold.DateLastAccessed
End Function
' *****************************************************************************
Public Function DateLastModified() As Date
DateLastModified = objFold.DateLastModified
End Function
' *****************************************************************************
Public Function name() As String
name = objFold.name
End Function
' *****************************************************************************
Public Function ParentFolder() As clsFSOFolder
Dim objFolder As clsFSOFolder
Set objFolder = New clsFSOFolder
Set ParentFolder = objFolder.Init(objFold.ParentFolder)
Set objFolder = Nothing
End Function
' *****************************************************************************
Public Function Size() As Currency
Size = objFold.Size
End Function
' *****************************************************************************
Public Function FolderType() As String
FolderType = objFold.FolderType
End Function
' *****************************************************************************
Public Function SubFolders() As clsFSOFolders
Select Case objFolders Is Nothing
Case False
Set SubFolders = objFolders
Case True
Set objFolders = New clsFSOFolders
Set SubFolders = objFolders.Init(objFold.SubFolders)
End Select
End Function
' *****************************************************************************
Public Function Files() As clsFSOFiles
Select Case objFiles Is Nothing
Case False
Set Files = objFiles
Case True
Set objFiles = New clsFSOFiles
Set Files = objFiles.Init(objFold.Files)
End Select
End Function
' *****************************************************************************
Public Function Move(Destination As String) As Boolean
On Error GoTo err_handle
objFold.Move Destination
Move = True
exit_err:
Exit Function
err_handle:
Move = False
Resume exit_err
End Function
' *****************************************************************************
Public Function Changed() As Boolean
' indicates if the contents of the folder have changed
Changed = (objFold.Files.Count <> lngFileCount) Or _
(Me.Size <> lngSize)
lngSize = Me.Size
lngFileCount = objFold.Files.Count
End Function
' *****************************************************************************
Public Function Exists() As Boolean
Exists = Not objFold Is Nothing
End Function
' *****************************************************************************
Private Sub objFiles_FileIndexed(FSOFile As clsFSOFile)
RaiseEvent FileIndexed(FSOFile)
End Sub
' *****************************************************************************
Private Sub objFolders_FolderIndexed(FSOFolder As clsFSOFolder)
RaiseEvent FolderIndexed(FSOFolder)
End Sub
