Over the years, I’ve posted punctual articles relating to individual FSO solutions:
VBA - Expand Short File or Path
Ok, I’ll admit it, expanding a Short format File or Directory Path is a niche ask, but I recently required this ability and so I thought I’d share my solution in case anyone else was faced with this need. Where did my need come from exactly? Well, I was setting a Reference dynamically and the…
VBA - Move a File from one Directory to Another
Here is a function to move a file from one folder to another.
and many, many more.
Today, I thought I’d provide you with a complete breakdown of the File System Object (FSO) most common functions to give you a proper overview of just how useful it can be to you when you need to interact with File, Folders and more.
There’s a lot of content to this article so I’ve broken it up into the following sections:
- FSO Self-Healing Object Variable (SHOV)
- Helper Functions
- Drives
- Files
- Folders
- Text Steam
- More Advanced Usage Examples
Let dive in!
FSO Self-Healing Object Variable (SHOV)
If you aren’t familiar with SHOV, I urge you to read up on the matter by reviewing:
Self-Healing Object Variables
So what does a developer do when he can’t sleep at 3am? He decides to write an article about self-healing object variables! So What Are Self-Healing Object Variables? In plain English, these are variables that are intelligent enough that they initialize themselves once and retain their value for the entire session. If reset, they will…
That said, all the code below depends on the following FSO SHOV:
' Req'd Refs: Late Binding -> None required
' Early Binding -> Microsoft Scripting Runtime
#Const FSO_EarlyBind = True
#If FSO_EarlyBind = True Then
Private pFSO As Scripting.FileSystemObject
#Else
Private pFSO As Object
#End If
#If FSO_EarlyBind = True Then
Public Function oFSO() As Scripting.FileSystemObject
#Else
Public Function oFSO() As Object
#End If
If pFSO Is Nothing Then
#If FSO_EarlyBind = True Then
Set pFSO = New FileSystemObject
#Else
Set pFSO = CreateObject("Scripting.FileSystemObject")
#End If
End If
Set oFSO = pFSO
End Function
Public Sub oFSO_Clear()
'Be sure to always run this when closing your Form/DB to avoid
' hidden instances from running in the background!
Set pFSO = Nothing
End Sub
Helper Functions
Below are a couple helper functions used in some of the FSO procedures:
Enum DataUnit
Bytes = 0
Kilobytes = 1
Megabytes = 2
Gigabytes = 3
Terabytes = 4
End Enum
'? ConvertBytes(1099511627776,GigaBytes)
' Returns -> 1024
'? ConvertBytes(1099511627776,TeraBytes)
' Returns -> 1
Public Function ConvertBytes(ByVal dBytes As Double, lUnits As DataUnit, Optional lNoDigits As Long = -9999) As Double
ConvertBytes = dBytes / (1024 ^ lUnits)
If lNoDigits <> -9999 Then
ConvertBytes = FormatNumber(ConvertBytes, lNoDigits)
End If
End Function
Function TrailingSlash(vInput As Variant) As String
If IsNull(vInput) = False Then
If Len(vInput) > 0 Then
If Right(vInput, 1) = "\" Then
TrailingSlash = vInput
Else
TrailingSlash = vInput & "\"
End If
End If
End If
End Function
Drives
Below you will find the following procedure (the title are self-explanatory I believe):
- FSO_Drive_GetDriveName
- FSO_Drive_GetDriveType
- FSO_Drive_GetFileSystem
- FSO_Drive_GetFreeSpace
- FSO_Drive_GetMappedDrivePath
- FSO_Drive_GetSerialNumber
- FSO_Drive_GetSize
' ? FSO_Drive_GetDriveName("C:")
' Returns -> C:
' ? FSO_Drive_GetDriveName("C:\")
' Returns -> C:
' ? FSO_Drive_GetDriveName("C:\Temp")
' Returns -> C:
Function FSO_Drive_GetDriveName(ByVal sDrive As String) As String
On Error GoTo Error_Handler
FSO_Drive_GetDriveName = oFSO.GetDriveName(sDrive)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Drive_GetDriveName" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
Resume Error_Handler_Exit
End Function
'? FSO_Drive_GetDriveType("C")
'? FSO_Drive_GetDriveType("C:")
'? FSO_Drive_GetDriveType("C:\")
'? FSO_Drive_GetDriveType("C:\Temp\")
' Returns -> Fixed
' Returns -> Null if the Drive doesn't exist
'? FSO_Drive_GetDriveType("E")
'? FSO_Drive_GetDriveType("E:")
'? FSO_Drive_GetDriveType("E:\")
' Returns -> CD-ROM
' Returns -> Null if the Drive doesn't exist
Function FSO_Drive_GetDriveType(ByVal sDrive As String) As Variant
On Error GoTo Error_Handler
Dim lDriveType As Long
If InStr(sDrive, "\") > 0 Then
lDriveType = oFSO.GetDrive(FSO_Drive_GetDriveName(sDrive)).DriveType
Else
lDriveType = oFSO.GetDrive(sDrive).DriveType
End If
Select Case lDriveType
Case 1: FSO_Drive_GetDriveType = "Removable"
Case 2: FSO_Drive_GetDriveType = "Fixed"
Case 3: FSO_Drive_GetDriveType = "Network"
Case 4: FSO_Drive_GetDriveType = "CD-ROM"
Case 5: FSO_Drive_GetDriveType = "RAM Disk"
Case Else: FSO_Drive_GetDriveType = "Unknown"
End Select
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 5 Or Err.Number = 68 Then 'Device unavailable
FSO_Drive_GetDriveType = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Drive_GetDriveType" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Drive_GetFileSystem("C")
'? FSO_Drive_GetFileSystem("C:")
'? FSO_Drive_GetFileSystem("C:\")
'? FSO_Drive_GetFileSystem("C:\Temp")
' Returns -> NTFS, exFAT, ...
' Returns -> Null if the Drive doesn't exist
Function FSO_Drive_GetFileSystem(ByVal sDrive As String) As Variant
On Error GoTo Error_Handler
If InStr(sDrive, "\") > 0 Then
FSO_Drive_GetFileSystem = CStr(oFSO.GetDrive(FSO_Drive_GetDriveName(sDrive)).FileSystem)
Else
FSO_Drive_GetFileSystem = CStr(oFSO.GetDrive(sDrive).FileSystem)
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 68 Then 'Device unavailable
FSO_Drive_GetFileSystem = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Drive_GetFileSystem" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Drive_GetFreeSpace("C")
'? FSO_Drive_GetFreeSpace("C:\Temp")
' Returns -> 53648846848
' Returns -> Null if the Drive doesn't exist
'? ConvertBytes(FSO_Drive_GetFreeSpace("C"), Megabytes)
' Returns -> 51160.23828125
Function FSO_Drive_GetFreeSpace(ByVal sDrive As String) As Variant
' returns the size in bytes
On Error GoTo Error_Handler
If InStr(sDrive, "\") > 0 Then
FSO_Drive_GetFreeSpace = CDbl(oFSO.GetDrive(FSO_Drive_GetDriveName(sDrive)).FreeSpace)
Else
FSO_Drive_GetFreeSpace = CDbl(oFSO.GetDrive(sDrive).FreeSpace)
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 68 Then 'Device unavailable
FSO_Drive_GetFreeSpace = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Drive_GetFreeSpace" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'---------------------------------------------------------------------------------------
' Procedure : FSO_Drive_GetMappedDrivePath
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Determine the Full Path of a local Mapped Drive
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> None required
' Early Binding -> Microsoft Scripting Runtime
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sDriveLetter : Drive letter to get the path of
'
' Usage:
' ~~~~~~
' ? FSO_Drive_GetMappedDrivePath("Z:")
' Returns -> \\Eng201\Stress
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2022-01-31 Initial Public Release
' Updated Error handler, Header block
' Added Conditional Compilation
' 2 2022-10-10 Update to match naming conventions and use SHOV!
'---------------------------------------------------------------------------------------
Function FSO_Drive_GetMappedDrivePath(ByVal sDriveLetter As String) As String
On Error GoTo Error_Handler
If oFSO.GetDrive(sDriveLetter).DriveType = 3 Then '3 => Network
FSO_Drive_GetMappedDrivePath = Replace(sDriveLetter, _
oFSO.GetDriveName(sDriveLetter), _
oFSO.GetDrive(sDriveLetter).ShareName)
Else
FSO_Drive_GetMappedDrivePath = sDriveLetter
End If
Error_Handler_Exit:
On Error Resume Next
If Not oFSO Is Nothing Then Set oFSO = Nothing
Exit Function
Error_Handler:
If Err.Number = 68 Then
'Not found, how do you want to handle this?!
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: FSO_Drive_GetMappedDrivePath" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'This is not the HD Serial Number!!!
'? FSO_Drive_GetSerialNumber("C:")
' Returns -> -521129881
Function FSO_Drive_GetSerialNumber(ByVal sDrive As String) As Variant
On Error GoTo Error_Handler
If InStr(sDrive, "\") > 0 Then
FSO_Drive_GetSerialNumber = oFSO.GetDrive(FSO_Drive_GetDriveName(sDrive)).SerialNumber
Else
FSO_Drive_GetSerialNumber = oFSO.GetDrive(sDrive).SerialNumber
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 68 Then 'Device unavailable
FSO_Drive_GetSerialNumber = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Drive_GetSerialNumber" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Drive_GetSize("C")
'? FSO_Drive_GetSize("C:\Temp")
' Returns -> 53649534976
' Returns -> Null if the Drive doesn't exist
'? ConvertBytes(FSO_Drive_GetSize("C"), Megabytes)
' Returns -> 51164.1210937
Function FSO_Drive_GetSize(ByVal sDrive As String) As Variant
' returns the size in bytes
On Error GoTo Error_Handler
If InStr(sDrive, "\") > 0 Then
FSO_Drive_GetSize = CDbl(oFSO.GetDrive(FSO_Drive_GetDriveName(sDrive)).TotalSize)
Else
FSO_Drive_GetSize = CDbl(oFSO.GetDrive(sDrive).TotalSize)
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 68 Then 'Device unavailable
FSO_Drive_GetSize = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Drive_GetSize" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
If you want to learn more about the FSO Drive Object (methods, properties, etc…), a great starting point is the official documentation which can be found at:
Files
Below you will find the following procedure (the title are self-explanatory I believe):
- FSO_File_Copy
- FSO_File_Delete
- FSO_File_Exist
- FSO_File_GetDateCreated
- FSO_File_GetDateLastModified
- FSO_File_GetDrive
- FSO_File_GetExt
- FSO_File_GetNameWExt
- FSO_File_GetNameWOExt
- FSO_File_GetPath
- FSO_File_GetShortName
- FSO_File_GetShortPath
- FSO_File_GetSize
- FSO_File_GetTempName
- FSO_File_GetType
- FSO_File_GetVersion
- FSO_File_Move
'Copy a File and keep original name
' ? FSO_File_Copy("C:\temp\test.docx", "C:\temp\test2\")
'Copy a File and rename the file at the same time
' ? FSO_File_Copy("C:\temp\test.docx", "C:\temp\test2\MyTest.docx")
'Copy a File and change extension
' ? FSO_File_Copy("C:\temp\test.docx", "C:\temp\testing.doc")
Function FSO_File_Copy(ByVal sFile As String, sDest As String, _
Optional bOverwrite As Boolean = False) As Boolean
On Error GoTo Error_Handler
Dim vFileName As Variant
vFileName = FSO_File_GetNameWExt(sFile)
If IsNull(vFileName) = True Then
FSO_File_Copy = False
Else
Call oFSO.CopyFile(sFile, sDest, bOverwrite)
If IsNull(FSO_File_GetNameWExt(sDest)) = True Then
FSO_File_Copy = oFSO.FileExists(sDest & vFileName)
Else
FSO_File_Copy = oFSO.FileExists(sDest)
End If
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found
ElseIf Err.Number = 70 Then 'Permission denied - File locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_Copy" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_Delete("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> True/False
Function FSO_File_Delete(ByVal sFile As String, Optional bForce As Boolean = False) As Boolean
On Error GoTo Error_Handler
Call oFSO.DeleteFile(sFile, bForce)
FSO_File_Delete = Not oFSO.FileExists(sFile)
'Alternately we could call our function
'FSO_File_Delete = Not FSO_File_Exist(sFile)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found, nothing to do?!
FSO_File_Delete = True
ElseIf Err.Number = 70 Then 'Permission denied - File locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_Delete" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_Exist("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> True/False
Function FSO_File_Exist(ByVal sFile As String) As Boolean
On Error GoTo Error_Handler
FSO_File_Exist = oFSO.FileExists(sFile)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_Exist" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
Resume Error_Handler_Exit
End Function
'? FSO_File_GetDateCreated("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> 8/10/2022 3:58:34 PM
' Returns -> Null if the file doesn't exist
'? Format(FSO_File_GetDateCreated("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg"), "yyyy-mmm-dd hh:nn:ss AMPM")
' Returns -> 2022-Aug-10 03:58:34 PM
' Returns -> Null if the file doesn't exist
Function FSO_File_GetDateCreated(ByVal sFile As String) As Variant
On Error GoTo Error_Handler
FSO_File_GetDateCreated = oFSO.GetFile(sFile).DateCreated
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found
FSO_File_GetDateCreated = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetDateCreated" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_GetDateLastModified("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> 8/10/2022 3:58:35 PM
' Returns -> Null if the file doesn't exist
Function FSO_File_GetDateLastModified(ByVal sFile As String) As Variant
On Error GoTo Error_Handler
FSO_File_GetDateLastModified = oFSO.GetFile(sFile).DateLastModified
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found
FSO_File_GetDateLastModified = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetDateLastModified" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_GetDrive("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> C:
' Returns -> Null if the file doesn't exist
Function FSO_File_GetDrive(ByVal sFile As String) As Variant
On Error GoTo Error_Handler
FSO_File_GetDrive = oFSO.GetFile(sFile).Drive
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Or Err.Number = -2147024894 Then 'File not found
FSO_File_GetDrive = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetDrive" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_GetExt("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> jpg
Function FSO_File_GetExt(ByVal sFile As String) As String
On Error GoTo Error_Handler
FSO_File_GetExt = oFSO.GetExtensionName(sFile)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetExt" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
Resume Error_Handler_Exit
End Function
'? FSO_File_GetNameWExt("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> Flow-Undo-Dont.jpg
' Returns -> Null if the file doesn't exist
Function FSO_File_GetNameWExt(ByVal sFile As String) As Variant
On Error GoTo Error_Handler
FSO_File_GetNameWExt = CStr(oFSO.GetFile(sFile).Name)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found
FSO_File_GetNameWExt = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetNameWExt" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_GetNameWOExt("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> Flow-Undo-Dont
Function FSO_File_GetNameWOExt(ByVal sFile As String) As String
On Error GoTo Error_Handler
FSO_File_GetNameWOExt = oFSO.GetBaseName(sFile)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetNameWOExt" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
Resume Error_Handler_Exit
End Function
'? FSO_File_GetPath("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> C:\Users\Daniel\Downloads
' Returns -> Null if the file doesn't exist
Function FSO_File_GetPath(ByVal sFile As String) As Variant
On Error GoTo Error_Handler
FSO_File_GetPath = oFSO.GetFile(sFile).ParentFolder
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found
FSO_File_GetPath = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetPath" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_GetShortName("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> FLOW-U~2.JPG
' Returns -> Null if the file doesn't exist
Function FSO_File_GetShortName(ByVal sFile As String) As Variant
On Error GoTo Error_Handler
FSO_File_GetShortName = oFSO.GetFile(sFile).ShortName
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Or Err.Number = -2147024894 Then 'File not found
FSO_File_GetShortName = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetShortName" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_GetShortPath("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> C:\Users\Daniel\DOWNLO~1\FLOW-U~2.JPG
' Returns -> Null if the file doesn't exist
Function FSO_File_GetShortPath(ByVal sFile As String) As Variant
On Error GoTo Error_Handler
FSO_File_GetShortPath = oFSO.GetFile(sFile).ShortPath
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Or Err.Number = -2147024894 Then 'File not found
FSO_File_GetShortPath = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetShortPath" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'*****FileLen is unreliable! Use this instead!!!!*****
'? FSO_File_GetSize("C:\Users\Daniel\Downloads\Contact_ERP.iso")
' Returns -> 5883697152
' Returns -> Null if the file doesn't exist
Function FSO_File_GetSize(ByVal sFile As String) As Variant
' returns the size in bytes
On Error GoTo Error_Handler
FSO_File_GetSize = CDbl(oFSO.GetFile(sFile).Size)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found
FSO_File_GetSize = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetSize" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_GetTempName
' Returns -> radD4E9B.tmp 'a randomly generated filename
Function FSO_File_GetTempName() As String
On Error GoTo Error_Handler
FSO_File_GetTempName = oFSO.GetTempName
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetTempName" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
Resume Error_Handler_Exit
End Function
'? FSO_File_GetType("C:\Users\Daniel\Downloads\en-us_windows_10_consumer_editions_version_21h2_x64_dvd_6cfdb144.iso")
' Returns -> Disc Image File
' Returns -> Null if the file doesn't exist
'? FSO_File_GetType("C:\Users\Daniel\Downloads\info.txt")
' Returns -> TXT File
' Returns -> Null if the file doesn't exist
'? FSO_File_GetType("C:\Users\Daniel\Downloads\Flow-Undo-Dont.jpg")
' Returns -> JPG File
' Returns -> Null if the file doesn't exist
Function FSO_File_GetType(ByVal sFile As String) As Variant
On Error GoTo Error_Handler
FSO_File_GetType = CStr(oFSO.GetFile(sFile).Type)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found
FSO_File_GetType = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetType" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_GetVersion(SysCmd(acSysCmdAccessDir) & "msaccess.exe")
' Returns -> 15.0.5349.1000
' Returns -> Null if the file doesn't exist
Function FSO_File_GetVersion(ByVal sFile As String) As Variant
On Error GoTo Error_Handler
FSO_File_GetVersion = oFSO.GetFileVersion(sFile)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Or Err.Number = -2147024894 Then 'File not found
FSO_File_GetVersion = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_GetVersion" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'Move a File and keep original name
' ? FSO_File_Move("C:\temp\test.docx", "C:\temp\test2\")
'Move a File and rename the file at the same time
' ? FSO_File_Move("C:\temp\test.docx", "C:\temp\test2\MyTest.docx")
'Rename a File
' ? FSO_File_Move("C:\temp\test.docx", "C:\temp\testing.docx")
'Rename a File and change extension
' ? FSO_File_Move("C:\temp\test.docx", "C:\temp\testing.doc")
Function FSO_File_Move(ByVal sFile As String, sDest As String) As Boolean
On Error GoTo Error_Handler
Dim vFileName As Variant
vFileName = FSO_File_GetNameWExt(sFile)
If IsNull(vFileName) = True Then
FSO_File_Move = False
Else
Call oFSO.MoveFile(sFile, sDest)
If IsNull(FSO_File_GetNameWExt(sDest)) = True Then
FSO_File_Move = oFSO.FileExists(sDest & vFileName)
Else
FSO_File_Move = oFSO.FileExists(sDest)
End If
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found
ElseIf Err.Number = 70 Then 'Permission denied - File locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_Move" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
If you want to learn more about the FSO File Object (methods, properties, etc…), a great starting point is the official documentation which can be found at:
Folders
Below you will find the following procedure (the title are self-explanatory I believe):
- FSO_Folder_Copy
- FSO_Folder_Create
- FSO_Folder_Delete
- FSO_Folder_Exist
- FSO_Folder_GetDateCreated
- FSO_Folder_GetDateLastModified
- FSO_Folder_GetDrive
- FSO_Folder_GetShortPath
- FSO_Folder_GetSize
- FSO_Folder_ListFiles
- FSO_Folder_Move
'Copy a Folder and keep original name
' ? FSO_Folder_Copy("C:\temp\test2", "C:\temp\charts\test2")
'Copy a Folder and rename the folder
' ? FSO_Folder_Copy("C:\temp\test2", "C:\temp\charts\test 2")
Function FSO_Folder_Copy(ByVal sSrc As String, sDest As String, _
Optional bOverwrite As Boolean = False) As Boolean
On Error GoTo Error_Handler
Call oFSO.CopyFolder(sSrc, sDest, bOverwrite)
FSO_Folder_Copy = FSO_Folder_Exist(sDest)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 58 Then 'Folder already exists
'? Use bOverwrite = True? Return False?
ElseIf Err.Number = 76 Then 'Folder not found
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_Copy" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Folder_Delete("C:\temp\charts\test2")
' Returns -> True/False
Function FSO_Folder_Create(ByVal sFolder As String) As Boolean
On Error GoTo Error_Handler
Call oFSO.CreateFolder(sFolder)
FSO_Folder_Create = oFSO.FolderExists(sFolder)
'Alternately we could call our function
'FSO_Folder_Create = FSO_DoeFolderExist(sFolder)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 58 Then 'Folder already exists
'Delete/try again? Just exit returning False?
ElseIf Err.Number = 70 Then 'Permission denied - Folder locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_Create" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Folder_Delete("C:\temp\charts\test2")
' Returns -> True/False
Function FSO_Folder_Delete(ByVal sFolder As String, Optional bForce As Boolean = False) As Boolean
'If there are open files, it will delete everything it can, but the open/locked files remain as does the folder itself. Odd.
On Error GoTo Error_Handler
Call oFSO.DeleteFolder(sFolder, bForce)
FSO_Folder_Delete = Not oFSO.FolderExists(sFolder)
'Alternately we could call our function
'FSO_Folder_Delete = Not FSO_DoeFolderExist(sFolder)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 76 Then 'Folder not found, nothing to do?!
ElseIf Err.Number = 70 Then 'Permission denied - Folder locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_Delete" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Folder_Exist("C:\Users\Daniel\Downloads\")
' Returns -> True/False
Function FSO_Folder_Exist(ByVal sFolder As String) As Boolean
On Error GoTo Error_Handler
FSO_Folder_Exist = oFSO.FolderExists(sFolder)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_Exist" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
Resume Error_Handler_Exit
End Function
'? FSO_Folder_GetDateCreated("C:\Users\Daniel\Downloads\")
' Returns -> 8/10/2022 3:58:34 PM
' Returns -> Null if the Folder doesn't exist
'? Format(FSO_Folder_GetDateCreated("C:\Users\Daniel\Downloads\"), "yyyy-mmm-dd hh:nn:ss AMPM")
' Returns -> 2022-Aug-10 03:58:34 PM
' Returns -> Null if the Folder doesn't exist
Function FSO_Folder_GetDateCreated(ByVal sFolder As String) As Variant
On Error GoTo Error_Handler
FSO_Folder_GetDateCreated = oFSO.GetFolder(sFolder).DateCreated
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 76 Then 'Folder not found
FSO_Folder_GetDateCreated = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_GetDateCreated" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Folder_GetDateLastModified("C:\Users\Daniel\Downloads\")
' Returns -> 8/10/2022 3:58:35 PM
' Returns -> Null if the Folder doesn't exist
Function FSO_Folder_GetDateLastModified(ByVal sFolder As String) As Variant
On Error GoTo Error_Handler
FSO_Folder_GetDateLastModified = oFSO.GetFolder(sFolder).DateLastModified
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 76 Then 'Folder not found
FSO_Folder_GetDateLastModified = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_GetDateLastModified" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Folder_GetDrive("C:\Temp\")
' Returns -> C:
Function FSO_Folder_GetDrive(ByVal sFolder As String) As Variant
On Error GoTo Error_Handler
FSO_Folder_GetDrive = oFSO.GetFolder(sFolder).Drive
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 76 Then 'Folder not found
FSO_Folder_GetDrive = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_GetDrive" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Folder_GetShortPath("C:\Users\Daniel\Downloads\")
' Returns -> C:\Users\Daniel\DOWNLO~1
' Returns -> Null if the Folder doesn't exist
Function FSO_Folder_GetShortPath(ByVal sFolder As String) As Variant
On Error GoTo Error_Handler
FSO_Folder_GetShortPath = oFSO.GetFolder(sFolder).ShortPath
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 76 Then ' Or Err.Number = -2147024894 Then 'Folder not found
FSO_Folder_GetShortPath = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_GetShortPath" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Folder_GetSize("C:\Users\Daniel\Downloads\")
' Returns -> 41487553718
' Returns -> Null if the Folder doesn't exist
'? ConvertBytes(FSO_Folder_GetSize("C:\Users\Daniel\Downloads\"), Megabytes)
' Returns -> 39565.6144313812
Function FSO_Folder_GetSize(ByVal sFolder As String) As Variant
' returns the size in bytes
On Error GoTo Error_Handler
FSO_Folder_GetSize = CDbl(oFSO.GetFolder(sFolder).Size)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 76 Then 'Path not found
FSO_Folder_GetSize = Null
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_GetSize" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_Folder_ListFiles("C:\temp\charts\")
Function FSO_Folder_ListFiles(ByVal sFolder As String) As Variant
On Error GoTo Error_Handler
Dim oFiles As Scripting.Files
Dim oFile As Scripting.File
Dim lCounter As Long
Set oFiles = oFSO.GetFolder(sFolder).Files
Debug.Print oFiles.Count & " Files Found in Folder: " & sFolder
For Each oFile In oFiles
lCounter = lCounter + 1
Debug.Print lCounter, oFile.Name
Next
Error_Handler_Exit:
On Error Resume Next
Set oFile = Nothing
Set oFiles = Nothing
Exit Function
Error_Handler:
If Err.Number = 76 Then 'Folder not found
ElseIf Err.Number = 70 Then 'Permission denied - Folder locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_Move" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'Move a Folder and keep original name
' ? FSO_Folder_Move("C:\temp\test2", "C:\temp\charts\test2")
'Move a Folder and rename the folder
' ? FSO_Folder_Move("C:\temp\test2", "C:\temp\charts\Testing")
'Do not include trailing \
Function FSO_Folder_Move(ByVal sSrc As String, ByVal sDest As String) As Boolean
On Error GoTo Error_Handler
Call oFSO.MoveFolder(sSrc, sDest)
FSO_Folder_Move = FSO_Folder_Exist(sDest)
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number = 76 Then 'Folder not found
ElseIf Err.Number = 70 Then 'Permission denied - Folder locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_Folder_Move" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
If you want to learn more about the Folder Object (methods, properties, etc…), a great starting point is the official documentation which can be found at:
TextStream
Below you will find the following procedure (the title are self-explanatory I believe):
- FSO_File_AppendFile
- FSO_File_CreateFile
- FSO_File_ReadAll
- FSO_File_ReadNoChars
#If FSO_EarlyBind = True Then
#Else
'OpenAsTextStream Constants
Private Const ForReading = 1 'Open a file for reading only. You can't write to this file.
Private Const ForWriting = 2 'Open a file for writing. If a file with the same name exists, its previous contents are overwritten.
Private Const ForAppending = 8 'Open a file and write to the end of the file.
Private Const TristateUseDefault = -2 'Opens the file by using the system default.
Private Const TristateTrue = -1 'Opens the file as Unicode.
Private Const TristateFalse = 0 'Opens the file as ASCII.
Private Const TristateMixed = -2 '??????????? same value as TristateUseDefault ?????????????
#End If
'Be careful! by default it continue from the last line so you may wish to start your sContent with a vbCr
'Append, continuing the last existing line
' ? FSO_File_AppendFile(vbcr & "C:\Temp\Sample2.txt", "Line 3" & vbCr & "Line 4", TristateFalse)
'Append, starting on a new line
' ? FSO_File_AppendFile("C:\Temp\Sample2.txt", vbCr & "Line 3" & vbCr & "Line 4", TristateFalse)
Function FSO_File_AppendFile(ByVal sFile As String, ByVal sContent As String, Optional lTristate As Long = TristateUseDefault) As Variant
On Error GoTo Error_Handler
#If FSO_EarlyBind = True Then
Dim oFSO_TS As Scripting.TextStream
#Else
Dim oFSO_TS As Object
#End If
Set oFSO_TS = oFSO.GetFile(sFile).OpenAsTextStream(ForAppending, lTristate)
Call oFSO_TS.Write(sContent)
FSO_File_AppendFile = True
Error_Handler_Exit:
On Error Resume Next
oFSO_TS.Close
Set oFSO_TS = Nothing
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found - occurs when file is open/locked
'File does not exist
FSO_File_AppendFile = False
ElseIf Err.Number = 70 Then 'Permission denied - File locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_AppendFile" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'Create a new text file, but don't overwrite it if it already exists
' ? FSO_File_CreateFile("C:\Temp\Sample.txt", "Line 1" & chr(13) & chr(10) & "Line 2", False)
'Create a new text file and overwrite it if it already exists
' ? FSO_File_CreateFile("C:\Temp\Sample.txt", "Line 1" & chr(13) & chr(10) & "Line 2", True)
' ? FSO_File_CreateFile("C:\Temp\Sample2.txt", "Line 22" & vbCr & "Line 11", True)
Function FSO_File_CreateFile(ByVal sFile As String, ByVal sContent As String, Optional bOverwrite As Boolean = False) As Variant
On Error GoTo Error_Handler
#If FSO_EarlyBind = True Then
Dim oFSO_TS As Scripting.TextStream
#Else
Dim oFSO_TS As Object
#End If
Set oFSO_TS = oFSO.CreateTextFile(sFile, bOverwrite)
Call oFSO_TS.Write(sContent)
FSO_File_CreateFile = True
Error_Handler_Exit:
On Error Resume Next
oFSO_TS.Close
Set oFSO_TS = Nothing
Exit Function
Error_Handler:
If Err.Number = 58 Then 'File already exists
FSO_File_CreateFile = Null
ElseIf Err.Number = 70 Then 'Permission denied - File locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_CreateFile" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_ReadAll("C:\Temp\Sample.txt")
' Returns -> Lorem ipsum dolor sit amet
' Returns -> Null if the file doesn't exist
Function FSO_File_ReadAll(ByVal sFile As String, Optional lTristate As Long = TristateUseDefault) As Variant
On Error GoTo Error_Handler
#If FSO_EarlyBind = True Then
Dim oFSO_TS As Scripting.TextStream
#Else
Dim oFSO_TS As Object
#End If
Set oFSO_TS = oFSO.GetFile(sFile).OpenAsTextStream(ForReading, lTristate)
FSO_File_ReadAll = oFSO_TS.ReadAll
Error_Handler_Exit:
On Error Resume Next
oFSO_TS.Close
Set oFSO_TS = Nothing
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found
FSO_File_ReadAll = Null
ElseIf Err.Number = 70 Then 'Permission denied - File locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_ReadAll" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
'? FSO_File_ReadNoChars("C:\Temp\Sample.txt", 5, TristateFalse)
' Returns -> Lorem
' Returns -> Null if the file doesn't exist
Function FSO_File_ReadNoChars(ByVal sFile As String, lNoChars As Long, Optional lTristate As Long = TristateUseDefault) As Variant
On Error GoTo Error_Handler
#If FSO_EarlyBind = True Then
Dim oFSO_TS As Scripting.TextStream
#Else
Dim oFSO_TS As Object
#End If
Set oFSO_TS = oFSO.GetFile(sFile).OpenAsTextStream(ForReading, lTristate)
FSO_File_ReadNoChars = oFSO_TS.Read(lNoChars)
Error_Handler_Exit:
On Error Resume Next
oFSO_TS.Close
Set oFSO_TS = Nothing
Exit Function
Error_Handler:
If Err.Number = 53 Then 'File not found
FSO_File_ReadNoChars = Null
ElseIf Err.Number = 70 Then 'Permission denied - File locked/in use/...
Else
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: FSO_File_ReadNoChars" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
End If
Resume Error_Handler_Exit
End Function
If you want to learn more about the TextStream Object (methods, properties, etc…), a great starting point is the official documentation which can be found at:
Advanced Usage Examples
Retrieving File Properties
Here’s one approach to retrieving file properties.
#Const Demo1_EarlyBind = False
#If Demo1_EarlyBind = True Then
Public Function FSO_GetFileInfo(ByVal sFile As String) As Scripting.Dictionary
#Else
Public Function FSO_GetFileInfo(ByVal sFile As String) As Object
#End If
On Error GoTo Error_Handler
#If Demo1_EarlyBind = True Then
Dim oFile As Scripting.File
Dim oFilePropsDict As Scripting.Dictionary
Set oFilePropsDict = New Scripting.Dictionary
#Else
Dim oFile As Object
Dim oFilePropsDict As Object
Set oFilePropsDict = CreateObject("Scripting.Dictionary")
#End If
Set oFile = oFSO.GetFile(sFile)
oFilePropsDict.Add "Attributes", oFile.Attributes
oFilePropsDict.Add "DateCreated", oFile.DateCreated
oFilePropsDict.Add "DateLastAccessed", oFile.DateLastAccessed
oFilePropsDict.Add "DateLastModified", oFile.DateLastModified
oFilePropsDict.Add "Drive", oFile.Drive
oFilePropsDict.Add "Name", oFile.Name
oFilePropsDict.Add "ParentFolder", oFile.ParentFolder
oFilePropsDict.Add "Path", oFile.Path
oFilePropsDict.Add "ShortName", oFile.ShortName
oFilePropsDict.Add "ShortPath", oFile.ShortPath
oFilePropsDict.Add "Size", oFile.Size
oFilePropsDict.Add "Type", oFile.Type
Set FSO_GetFileInfo = oFilePropsDict
Error_Handler_Exit:
On Error Resume Next
Set oFile = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: FSO_GetFileInfo" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has occurred!"
Resume Error_Handler_Exit
End Function
Then to list all the properties you could do:
Sub TestFSO_GetFileInfo1()
#If Demo1_EarlyBind = True Then
Dim oFilePropsDict As Scripting.Dictionary
#Else
Dim oFilePropsDict As Object
#End If
Dim vKey As Variant
Set oFilePropsDict = FSO_GetFileInfo("C:\Temp\Sample.txt")
For Each vKey In oFilePropsDict.Keys
Debug.Print vKey, oFilePropsDict(vKey)
Next
Set oFilePropsDict = Nothing
End Sub
Or to list select properties you could do:
Sub TestFSO_GetFileInfo2()
#If Demo1_EarlyBind = True Then
Dim oFilePropsDict As Scripting.Dictionary
#Else
Dim oFilePropsDict As Object
#End If
Set oFilePropsDict = FSO_GetFileInfo("C:\Temp\Sample.txt")
Debug.Print oFilePropsDict("DateCreated")
Debug.Print oFilePropsDict("Size")
Debug.Print oFilePropsDict("Type")
Set oFilePropsDict = Nothing
End Sub
Get A Folder Listing
One could get a folder, and subfolder optionally, listing with a function like:
#Const Demo2_EarlyBind = False
Function oListSubFldrs(ByVal sPath As String, Optional bListSubFldrs As Boolean = True) As Collection
On Error GoTo Error_Handler
#If Demo2_EarlyBind = True Then
Dim oFldr As Scripting.Folder
Dim oSubFldr As Scripting.Folder
Dim oSubFldrs As VBA.Collection
#Else
Dim oFldr As Object
Dim oSubFldr As Object
Dim oSubFldrs As Object
#End If
Set oListSubFldrs = New VBA.Collection
Set oSubFldrs = New VBA.Collection
Set oFldr = oFSO.GetFolder(sPath)
For Each oSubFldr In oFldr.SubFolders
Call oListSubFldrs.Add(oSubFldr)
If bListSubFldrs = True Then
Set oSubFldrs = oListSubFldrs(TrailingSlash(oSubFldr.Path), bListSubFldrs)
For Each oFldr In oSubFldrs
Call oListSubFldrs.Add(oFldr)
Next
End If
Next oSubFldr
Error_Handler_Exit:
On Error Resume Next
Set oSubFldrs = Nothing
Set oSubFldr = Nothing
Set oFldr = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: oListSubFldrs" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has occurred!"
Resume Error_Handler_Exit
End Function
Then, to get a folder listing without subfolders, you could do:
Sub Test_oListSubFldrs()
Dim oSubFldrs As VBA.Collection
Dim oFldr As Variant
Set oSubFldrs = oListSubFldrs("C:\Temp\Test2", False) 'No SubFolderrs
Debug.Print oSubFldrs.Count & " folder(s) found."
For Each oFldr In oSubFldrs
Debug.Print , oFldr
Next
Set oSubFldrs = Nothing
End Sub
To get a folder listing with subfolders, you could do:
Sub Test_oListSubFldrs()
Dim oSubFldrs As VBA.Collection
Dim oFldr As Variant
Set oSubFldrs = oListSubFldrs("C:\Temp\Test2", True) 'Include SubFolders
Debug.Print oSubFldrs.Count & " folder(s) found."
For Each oFldr In oSubFldrs
Debug.Print , oFldr
Next
Set oSubFldrs = Nothing
End Sub
Get A File Listing
One could get a list of files within a folder, and optionally within the subfolders, with a function like:
#Const Demo3_EarlyBind = False
Function oListFiles(ByVal sPath As String, Optional bListSubFldrs As Boolean = True) As Collection
On Error GoTo Error_Handler
#If Demo3_EarlyBind = True Then
Dim oFldr As Scripting.Folder
Dim oSubFldr As Scripting.Folder
Dim oFiles As VBA.Collection
Dim oFile As Scripting.File
#Else
Dim oFldr As Object
Dim oSubFldr As Object
Dim oFiles As Object
Dim oFile As Object
#End If
Set oListFiles = New VBA.Collection 'Total List of Files
Set oFiles = New VBA.Collection 'List of Files for each Folder
Set oFldr = oFSO.GetFolder(sPath)
For Each oFile In oFldr.Files
Call oListFiles.Add(oFile)
Next
If bListSubFldrs = True Then
For Each oSubFldr In oFldr.SubFolders
Set oFiles = oListFiles(TrailingSlash(oSubFldr.Path), bListSubFldrs)
For Each oFile In oFiles
Call oListFiles.Add(oFile)
Next
Next oSubFldr
End If
Error_Handler_Exit:
On Error Resume Next
Set oFile = Nothing
Set oSubFldr = Nothing
Set oFiles = Nothing
Set oFldr = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: oListFiles" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has occurred!"
Resume Error_Handler_Exit
End Function
And return a listing of files within a specified folder by doing:
Sub Test_oListFiles()
Dim oFiles As VBA.Collection
Dim oFile As Variant
Set oFiles = oListFiles("C:\Temp\Test2", False) 'No SubFolders
Debug.Print oFiles.Count & " File(s) found."
For Each oFile In oFiles
Debug.Print , oFile
Next
Set oFiles = Nothing
End Sub
And return a listing of files within a folder and all of its subfolders by doing:
Sub Test_oListFiles()
Dim oFiles As VBA.Collection
Dim oFile As Variant
Set oFiles = oListFiles("C:\Temp\Test2", True) 'Include SubFolders
Debug.Print oFiles.Count & " File(s) found."
For Each oFile In oFiles
Debug.Print , oFile
Next
Set oFiles = Nothing
End Sub
Final Remarks
As you can see for yourself, FSO has a lot to offer for interacting with Files/Folder/Drives and is most certainly worth the time to get more familiar with.
I’ve been asked in the past why I build Subs/Functions around the existing methods and properties. This is a very valid question and it is primarily to perform error handling. As you can see I quite often use error handling to trap issue and control the returned output. So instead of having to do so in each call of the method/property, this way I have a reusable procedure that does it automatically. It’s just what I’ve found works best IMHO.
Daniel great job.
You are now a fundamental point of reference for us beginners.
Lorenzo
This is what you call great work,
thank you very much.
Thank you for the positive feedback!
These are very helpful, as always – great work and thanks for sharing
Commendable job, specially for beginners like us, Thanks! Thanks a lot.