The FileSystemObject Complete Story (1 Viewer)

Status
Not open for further replies.

Dreamweaver

Well-known member
Local time
Today, 04:22
Joined
Nov 28, 2005
Messages
2,466
Please only post questions to The General Forum Thanks Mick
I've decided to do this while finalising one of my projects file and folder interactions.

Some Background and the way I do things when dealing with large file systems

First I have a main folder that contains about 27 Sub Folders

Like this J:\Entities Folder\A

Because I have a copy of those main folders and all sub-folders on my laptop plus I may decide to move to another drive or server I Store the location in 2 places.

This part is stored in a setup Table "J:\Entities Folder\"

Then when I Add a file I only store This part of the file location A\Incoming Mail\ Hi Mick.txt

To get the full location I put the 2 together like Setup Location & File Location

This is created like This (Which I will leave in place in all functions you'll just need to update the names of tables and fields)
Ext = First Letter Of Entities Name
StrArt = Full File Validated Name of Entity
Select Case Ext
Case "A" To "Z"
'Do Nothing
Case Else
Ext = "0-10"
End Select
StrExtShort = Ext & "\" & StrArt
StrExt = DLookup("FoldersRoot", "tblSetup") & Ext & "\" & StrArt
So The Full Path For A Folder Is Created In StrExt For All New Entities
At the min the system creates a set of default folder As below for each entity added to the system that is Allowed a folder (That depends On the selected Entity Type)

My System is huge hence the need for really good File management being there are over 990,000 Folders and about 470,000 Files not counting Files stored on another drive Called Music which also is linked to Discs And Tracks There's about 75Gb On That drive.

At the min I have 4 Main Linked Databases that hold the main data currently just under 800Mg Plus about 7 import satellites of 1.4Gb, 14Gb Of Other Related Files Like Pictures, Plus the 75Gb Of Music Spread across 3 drives (I was A DJ for 10 Years LOL).

So I have been working towards fully automating what needs to be done with these files and folders within the database All the function I have developed to handle Adding, Editing, Renaming, Moving, Deleting, Backing Up Plus a lot of others will be posted into this topic over the next few weeks I hope somebody finds them useful

First Create The Default Folders For An Entity
I will post an example when I update the system to create default Folders for an entity depending on there selected type as this is quite involved so I'll do an example db for that one.

Code:
Function CreateFolders(Ext As String, StrArt As String) As String
Dim fs
Dim StrExt As String
Dim StrExtShort As String
On Error Resume Next 'GoTo HandleErr
    Select Case Ext
        Case "A" To "Z"
        'Do Nothing
        Case Else
        Ext = "0-10"
    End Select
StrExtShort = Ext & "\" & StrArt
StrExt = DLookup("FoldersRoot", "tblSetup") & Ext & "\" & StrArt
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FolderExists(StrExt) Then
        fs.CreateFolder (StrExt)
        fs.CreateFolder (StrExt & "\Pictures")
        fs.CreateFolder (StrExt & "\Record Covers")
        fs.CreateFolder (StrExt & "\Record Covers\Singles")
        fs.CreateFolder (StrExt & "\Record Covers\Albums")
        fs.CreateFolder (StrExt & "\Pictures\Group Pictures")
        fs.CreateFolder (StrExt & "\Book Covers")
        fs.CreateFolder (StrExt & "\Record Covers\DVD-Video Covers")
        fs.CreateFolder (StrExt & "\Screen Savers")
        fs.CreateFolder (StrExt & "\Wallpaper")
        fs.CreateFolder (StrExt & "\Media Info")
        fs.CreateFolder (StrExt & "\Pictures\animations")
End If
CreateFolders = StrExtShort

End Function

Editing A File Name
Code:
Function EditFileNames(StrFile As String, StrExt As String, StrNewName As String)
    Dim fs, F, S
    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not fs.fileExists(StrFile) Then
        MsgBox "Cannot Find File"
        Exit Function
    End If
    Set F = fs.GetFile(StrFile)
    F.Name = StrNewName & StrExt
End Function

Deleting File
Code:
Function DeleteFile(StrFile As String)
    Dim fs, F, S
    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not fs.fileExists(StrFile) Then
        MsgBox "Cannot Find File"
        Exit Function
    End If
    fs.DeleteFile StrFile, True
End Function

Create A Deleted Items Folder for times when folders cannot be deleted because of included files that you may wish to move to other locations.
This is a custom function I use for my personal system

Code:
Function DoMoveToDeletedItems(StrFolder As String)
'First We need to check to see if our folder system has our own deleted items
'This will store only folders with files so the admin can check the files and move them or delete them
'You must also update any stored locations within your db so the links to files are removed
Dim fs
Dim DelFld As String 'Stores the full path to the deleted items folder Sub Folder on Root?
Dim Rt As String
On Error GoTo HandleErr

Rt = DLookup("FoldersRoot", "tblSetup")
DelFld = Rt & "Deleted Items"
'If this folder has not been created IE First time An entity has been deleted with files then create it.
Set fs = CreateObject("Scripting.FileSystemObject")
    'Check The Folder Exists
    If Not fs.FolderExists(DelFld) Then fs.CreateFolder (DelFld)
    'Now we know we have a Deleted Items Move the main Folder and All contents into the deleted Items
    fs.MoveFolder Rt & StrFolder, DelFld & "\"
    'And Thats That Just Clean Up

HandleExit:
On Error Resume Next
   fs = Nothing
    Exit Function
    
HandleErr:
    MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
    Resume HandleExit
End Function
 
Last edited:

Dreamweaver

Well-known member
Local time
Today, 04:22
Joined
Nov 28, 2005
Messages
2,466
Getting A Complete Count Of All Files (This is needed for my system so if an entitie is to be deleted I need to check if that entity has any files before I delete them if so I can then decide what to do about them)

This requires a global Counter Added under Options Option Explicit
Code:
 Option Explicit
Public CFiles As Long

Code:
Function CanDelFolders(StrLoc As String)
Dim fs, F, f1, S, sf, buffer$, AllFiles, file

    Set fs = CreateObject("Scripting.FileSystemObject")
    'Check The Folder Exists
    If Not fs.FolderExists(StrLoc) Then Exit Function

    Set F = fs.GetFolder(StrLoc)
    Set sf = F.SubFolders
    For Each f1 In sf
       Set AllFiles = f1.Files
        CFiles = CFiles + AllFiles.Count
        buffer$ = f1.Path
        'Call myself with the new path!
        CanDelFolders buffer$
        
    Next
    'Debug.Print CFiles
    
End Function

Forgot this bit (Calling The Function)
Note you must set the global to 0 before you call this function as below
Code:
CFiles = 0
If Me![StartInFolder]<>"" Then CanDelFolders (DLookup("FoldersRoot", "tblSetup") & Me![StartInFolder])
 
Last edited:

Dreamweaver

Well-known member
Local time
Today, 04:22
Joined
Nov 28, 2005
Messages
2,466
This is what I use As part of the entities Delete Function alonge will all the Other checks LOL

This will move a folder for an entity and all Sub Folder And File to a Folder so The files can be checked my the Admin before deleting.

The Admin Section of the folder management will come later and will require a Full Example DB Which will make life simple for anybody wishing to make use of it.

Code:
Function DoMoveToDeletedItems(StrFolder As String)
'First We need to check to see if our folder system has our own deleted items
'This will store only folders with files so the admin can check the files and move them or delete them
'You must also update any stored locations within your db so the links to files are removed
Dim fs
Dim DelFld As String 'Stores the full path to the deleted items folder Sub Folder on Root?
Dim Rt As String
On Error GoTo HandleErr

Rt = DLookup("FoldersRoot", "tblSetup")
DelFld = Rt & "Deleted Items"
'If this folder has not been created IE First time An entity has been deleted with files then create it.
Set fs = CreateObject("Scripting.FileSystemObject")
    'Check The Folder Exists
    If Not fs.FolderExists(DelFld) Then fs.CreateFolder (DelFld)
    'Now we know we have a Deleted Items Move the main Folder and All contents into the deleted Items
    fs.MoveFolder Rt & StrFolder, DelFld & "\"
    'And Thats That Just Clean Up

HandleExit:
    On Error Resume Next
   fs = Nothing
    Exit Function
    
HandleErr:
    MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
    Resume HandleExit
End Function

Calling This Function (This will depend on the Result of the CanDelFolders function)

Code:
        If CFiles <> 0 Then
               DoMoveToDeletedItems Me![StartInFolder]
        Else
        'Delete The folder and all sub folders
        'Look At The Delete Folder Post In This topic
        
        End If
 

Dreamweaver

Well-known member
Local time
Today, 04:22
Joined
Nov 28, 2005
Messages
2,466
Deleting A Folder
This will completely delete a folder and all it's contents so use it with care.

And completes the events for deleting an entity whether A Customer or a project folder within a customers folder

You should note this function will give a warning message so if you own delete procedure has a warning the user will get both but this one covers the deletion of a folder which may or may not have files

Code:
Function DoDelFolders(StrLoc As String)
'Use This at your own risk
'Make sure you have a Folder To Delete
Dim fs
Dim Rt As String
On Error GoTo HandleErr

Rt = DLookup("FoldersRoot", "tblSetup")

If StrLoc = "" Or Rt = "" Then  'Don't let somebody delete Anything until it's 100%
MsgBox "No Root Folder or entities folder has been supplied both are require to be able to continue!!", vbCritical, "Invalid Request"
Exit Function
End If
Set fs = CreateObject("Scripting.FileSystemObject")
'As A Double Check you could check the folder only contains X Sub Folders to prevent a boo boo
If MsgBox("You Are About To Delete Folder(" & Rt & StrLoc & ") The Files And All Sub Folders will be deleted" & vbCrLf & "THIS ACTION CANNOT BE UNDONE" & vbCrLf & "Are you SURE!!!", vbCritical + vbYesNo, "FINAL DELETE WARNING") = vbYes Then
        fs.DeleteFolder Rt & StrLoc 'This wont delete a read only folder?
End If

HandleExit:
On Error Resume Next
   fs = Nothing
    Exit Function
    
HandleErr:
    MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
    Resume HandleExit
End Function

This is the updated Call as in my last post on moving folders with Files

Code:
        If CFiles <> 0 Then
              DoMoveToDeletedItems Me![StartInFolder]
        Else
        'Delete The folder and all sub folders
              DoDelFolders Me![StartInFolder]
        End If

So now we know how a folder or set of folders can be created now we can start managing them.

So the sequence of events for the Delete entity with a folder within the db is
First Check if that entity has a set of folders and do they have files "CanDelFolders()"
Then depending on wether files have been found Run either the DoMoveToDeletedItems Function Or DoDelFolders Function.

Next we'll start organizing things which will include renaming files and folders attaching them to a system where the user can get access without having to go hunting for them


Basic File Search for files of a type

Code:
With Application.FileSearch
        .NewSearch
        .Filename = "*.jpg" 'Only looking for pritty pics
        .LookIn = Your Folder Full Path
        .Execute
        J = .FoundFiles.Count
    'If your have files you can do something with them by looping through Each File In A Folder
 
Last edited:
Status
Not open for further replies.

Users who are viewing this thread

Top Bottom