Yesterday I blogged about a simple class to parse file names, and that inspired me to improve it and add some functionality, which will actually come in handy for a project at work shortly.
The class is pretty self-explanatory, there is really nothing complicated in the code.
When the class is initialized, if a path to a directory (i.e. ending with \) is passed to the constructor the directory is created if it does not exist. If the directory exist, there are functions to copy or move both single files or all files in the directory. Directories can also be deleted using the RemoveDir method.
In addition, there are properties to get the path, file name, extension and file size (in bytes) of the file (if the class was initialized with a file name).
Here is an agent with some examples of how to call the class:
Option Public
Option Declare
Use "Class.FileFunctions"
Sub Initialize
Dim file As FileObject
Dim cnt As Integer
Dim success As Boolean
'*** Create new file object
Set file = New FileObject("D:\Downloads\Downloads\MERP\Assassins of Dol Amroth.pdf")
'*** Copy the file to another (new) directory
Call file.CopyTo("D:\Downloads\MERP1\", file.FileName)
'*** Move the file to a new location and replace space with + in file name
Call file.MoveTo("D:\Downloads\MERP2\", Replace(file.FileName," ","+"))
'*** Create a new directory if it does not exist
Set file = New FileObject("D:\Downloads\MERP3\Test\")
'*** Copy all files in specified directory to another directory
Set file = New FileObject("D:\Downloads\Downloads\MERP\")
cnt = file.CopyAllTo("D:\Downloads\MERP\Backup\")
MsgBox "Copied " & cnt & " files."
'*** Move all files in the previously specified directory to another location
cnt = file.MoveAllTo("D:\Downloads\Middle-Earth Role Playing Game\")
MsgBox "Moved " & cnt & " files."
'*** Remove D:\Downloads\Downloads\MERP\
Call file.RemoveDir("")
'*** Remove D:\Downloads\MERP3\ and Test directory that we created earlier
success = file.RemoveDir("D:\Downloads\MERP3\Test\")
If success = True Then
success = file.RemoveDir("D:\Downloads\MERP3\")
If success = False Then
MsgBox "Failed to delete D:\Downloads\MERP3\"
End If
Else
MsgBox "Failed to delete D:\Downloads\MERP3\Test\"
End If
End Sub
Below is the class itself, I put it in a script library called Class.FileFunctions.
%REM
Copyright (c) Karl-Henry Martinsson 2012.
Some code copyright Andre Guirard (see below).
You are free to use and modify my code, as long as you keep
all copyright info intact. If you improve the code, please
consider sharing it back to the community.
%END REM
Option Public
Option Declare
Type FileDetails
path As String
filename As String
extension As String
filesize As Long
End Type
Class FileObject
Private file As FileDetails
Public silent As Boolean
Public Sub New(filepathname As String)
silent = False
FullPathName = filepathname
If file.FileName = "" Then
If file.Path <> "" Then
On Error 76 GoTo parentDoesNotExist
'No filename but path, then we create that directory (if missing)
If Dir$(file.Path,16)="" Then
createDirectory:
Call MakeDir(file.Path)
End If
End If
file.FileSize = 0
Else
file.FileSize = FileLen(filepathname)
End If
Exit Sub
parentDoesNotExist:
Resume createDirectory
End Sub
Public Property Set FileName As String
file.FileName = FileName
file.Extension = StrRightBack(FileName,".")
End Property
Public Property Get FileName As String
FileName = file.FileName
End Property
Public Property Get Extension As String
Extension = file.Extension
End Property
Public Property Set Extension As String
file.Extension = Extension
End Property
Public Property Set FilePath As String
file.Path = FilePath
If Right(file.Path,1)<>"\" Then
file.Path = file.Path & "\"
End If
End Property
Public Property Get FilePath As String
FilePath = file.Path
End Property
Public Property Set FullPathName As String
Me.FilePath = StrLeftBack(FullPathName,"\")
Me.FileName = StrRightBack(FullPathName,"\")
End Property
Public Property Get FullPathName As String
FullPathName = file.Path & file.FileName
End Property
Public Function CopyTo(ByVal newpath As String, ByVal newname As String) As Boolean
'*** Check if both arguments are blank, then exit
If FullTrim(newpath) = "" Then
If FullTrim(newpath) = "" Then
CopyTo = False
Exit Function
End If
End If
If FullTrim(newpath) = "" Then
newpath = file.Path
End If
If FullTrim(newname) = "" Then
newname = file.FileName
End If
Call MakeDir(newpath)
On Error GoTo errHandlerCopyTo
FileCopy me.FullPathName, newpath + newname
If silent = False Then
Print "Copied " & filename & " from " & file.Path & " to " & newpath
End If
CopyTo = True
exitFunctionCopyTo:
Exit Function
errHandlerCopyTo:
CopyTo = False
Resume exitFunctionCopyTo
End Function
Public Function MoveTo(ByVal newpath As String, ByVal newname As String) As Boolean
'*** Check if both arguments are blank, then exit
If FullTrim(newpath) = "" Then
If FullTrim(newpath) = "" Then
MoveTo = False
Exit Function
End If
End If
If FullTrim(newpath) = "" Then
newpath = file.Path
End If
If FullTrim(newname) = "" Then
newname = file.FileName
End If
Call MakeDir(newpath)
On Error GoTo errHandlerMoveTo
FileCopy me.FullPathName, newpath + newname
Kill me.FullPathName
If silent = False Then
Print "Moved " & filename & " from " & file.Path & " to " & newpath
End If
MoveTo = True
exitFunctionMoveTo:
Exit Function
errHandlerMoveTo:
MoveTo = False
Resume exitFunctionMoveTo
End Function
Public Function CopyAllTo(ByVal newpath As String) As Integer
Dim filename As String
Dim filecount As Integer
'*** Check if both arguments are blank, then exit
If FullTrim(newpath) = "" Then
If FullTrim(newpath) = "" Then
CopyAllTo = 0
Exit Function
End If
End If
If FullTrim(newpath) = "" Then
newpath = file.Path
End If
Call MakeDir(newpath)
On Error GoTo errHandlerCopyAllTo
filename = Dir$(file.Path,2) ' Include hidden files
Do until filename=""
FileCopy file.Path + filename, newpath + filename
If silent = False Then
Print "Copying " & filename & " from " & file.Path & " to " & newpath
End If
filecount = filecount + 1
filename = Dir$()
Loop
CopyAllTo = filecount
exitFunctionCopyAllTo:
Print "Copied " & filecount & " files"
Exit Function
errHandlerCopyAllTo:
CopyAllTo = filecount
Resume exitFunctionCopyAllTo
End Function
Public Function MoveAllTo(ByVal newpath As String) As Integer
Dim filename As String
Dim filecount As Integer
Dim deletelist List As String
'*** Check if both arguments are blank, then exit
If FullTrim(newpath) = "" Then
If FullTrim(newpath) = "" Then
MoveAllTo = 0
Exit Function
End If
End If
If FullTrim(newpath) = "" Then
newpath = file.Path
End If
Call MakeDir(newpath)
On Error GoTo errHandlerMoveAllTo
filename = Dir$(file.Path,2) ' Include hidden files
Do Until filename=""
FileCopy file.Path + filename, newpath + filename
If silent = False Then
Print "Moving " & filename & " from " & file.Path & " to " & newpath
End If
deletelist(filename) = file.Path + filename
filecount = filecount + 1
filename = Dir$()
Loop
Print "Cleaning up..."
ForAll f In deletelist
Kill f
End ForAll
MoveAllTo = filecount
exitFunctionMoveAllTo:
Print "Moved " & filecount & " files"
Exit Function
errHandlerMoveAllTo:
MoveAllTo = filecount
Resume exitFunctionMoveAllTo
End Function
Public Function RemoveDir(ByVal dirpath As String) As Boolean
'*** If blank, use the path in object
If FullTrim(dirpath) = "" Then
dirpath = file.path
End If
On Error GoTo errHandlerRemoveDir
RmDir dirpath
RemoveDir = True
exitRemoveDir:
Exit Function
errHandlerRemoveDir:
RemoveDir = False
Resume exitRemoveDir
End Function
' ===== Private Supporting Functions =====
Private Sub MakeDir(Byval strWhere As String)
' *** This code by Andre Guirard @ IBM
' *** http://www-10.lotus.com/ldd/bpmpblog.nsf/dx/recursive-mkdir-vs.-iteration
' *** Using an iterative method instead of recursive due to stack issues (see link above)
On Error 76 Goto parentDoesNotExist
Dim stack$
Const NL = {
}
Do
Mkdir strWhere
On Error Goto 0 ' first success, stop trapping errors; avoid infinite loop.
strWhere = Strleft(stack, NL) ' "pop" a path for next iteration
stack = Mid$(stack, Len(strWhere)+2)
failed:
Loop Until strWhere = ""
Exit Sub
parentDoesNotExist:
' This error code can indicate other problems, but assume missing parent.
' If not, we get a different error (75) later when trying to create the parent.
Dim fpath$, fname$
SplitFilepath strWhere, fpath, fname
If fpath = "" Then Error 76, "Invalid path: '" & strWhere & "'"
stack = strWhere & NL & stack ' "push" onto stack to retry later.
strWhere = fpath ' try a path one step shorter.
Resume failed
End Sub
Private Sub SplitFilePath(Byval fullpath$, dirpath$, filename$)
' *** This subroutine by Andre Guirard @ IBM
' *** http://www-10.lotus.com/ldd/bpmpblog.nsf/dx/recursive-mkdir-vs.-iteration
' *** Called from MakeDir()
Const DELIMS = {/\:}
While Instr(DELIMS, Right$(fullPath, 1)) ' discard final delimiter character...
fullpath = Left$(fullpath, Len(fullpath)-1)
Wend
Dim candidate$, i%
filename = Strtoken(fullpath, Left$(DELIMS, 1), -1)
For i = 2 To Len(DELIMS)
candidate = Strtoken(fullpath, Mid$(DELIMS, i, 1), -1)
If Len(candidate) < Len(filename) Then
filename = candidate
End If
Next
Dim fplen%
fplen = Len(fullpath)-Len(filename)
If fplen > 0 Then fplen = fplen - 1
dirpath = Left$(fullpath, fplen)
End Sub
End Class
Enjoy!