Total Visual SourceBook

Total Visual SourceBook CD and Printed Manual

Microsoft Access/ Office 2016, 2013, 2010, and 2007 Version
is Shipping!

New features in Total Visual SourceBook for Access, Office 2007 and VB6

Supports Access/Office 2016, 2013, 2010 and 2007, and Visual Basic 6.0!

Separate version for Access/Office 2003, 2002, and 2000.

Separate version for:
Access 97/95


View all FMS products for Microsoft AccessAll Our Microsoft Access Products

SourceBook Info:

Why SourceBook?

 

"The code is exactly how I would like to write code and the algorithms used are very efficient and well-documented."

Van T. Dinh, Microsoft MVP

 

 

 

Microsoft Access, Office/VBA, VB6 Modules royalty-free source code libraryMicrosoft Access Modules royalty-free source code libraryMicrosoft Access VBA and VB6 Module Library Free trial of Total Visual SourceBook for Microsoft Access, Office, VB6 and VBA

Module: FileDisk in Category Windows : File and Disk Operations from Total Visual SourceBook

File, directory and disk manipulation routines to copy, delete, and move files, folder and subfolders using built-in functions in VB6 and VBA 32 and 64 bit.

Procedure List

Procedure Name

Type

Description

(Declarations) Declarations Declarations and private variables for the modFileDisk module
AddLineNumbersToFile Procedure Add line numbers to a text file.
AppendToTextFile Procedure Append the supplied string to the named text file.
CountLinesInTextFile Procedure Count the number of line in a text file.
CopyDirectory Procedure Copy all the files from one directory (folder) to another. Note: does not copy files in sub-directories
CopyFile Procedure Copy one file.
CreateFileFromText Procedure Create (save) a file containing the text you provide, overwriting the file if it already exists.
IsFolder Procedure Determine if a folder exists as specified from a drive letter (e.g. C:\Folder). This procedure is identical to DirectoryExists, but provided if you prefer to use Folder rather than Directory.
IsFile Procedure Determine if a file name exists. This also returns TRUE if the file is a folder with trailing slash containing at least one file, but use IsFolder instead to check if a directory name exists. This procedure is identical to FileExists, but provided as an alternative name.
DirectoryExists Procedure Determine if a directory exists as specified by drive letter (e.g. C:\Directory). This procedure is identical to FolderExists, but provided if you prefer to use Directory rather than Folder.
DirectoryExistsUNC Procedure Determine if a folder (directory) exists including references to universal naming convention (UNC) folders.
DriveExists Procedure Determine if a drive letter exists.
AvailableDrives Procedure Determine which drives are currently available.
DirectoriesToArray Procedure Populate the passed array with a list of directories in the specified directory (folder); does not include subfolders.
DirectoriesToArrayRecursive Procedure Recursively populate the passed array with a list of folders in the specified folder plus all its subfolders.
FileExists Procedure Determine if a file name exists. This also returns TRUE if the file is a folder with trailing slash containing at least one file. Use DirectoryExists instead to check if a directory name exists.
FilesToArray Procedure Populate the passed array with a list of files in the specified directory.
FilesInSubFoldersToArray Procedure Create a list of all files with their full path in the specified folder (directory) and all its subfolders.
FilesToArrayRecursive Procedure Recursively populate the passed array with a list of files in the specified folder plus all its subfolders.
GetFileName Procedure Get the name and extension of a file name by removing the drive and folder path.
GetFileNameNoExt Procedure Get the name of a file without the path or extension.
GetFullFileNameNoExt Procedure Get the name of a file and its path without the extension.
GetFileExtension Procedure Get the extension of a file (the text after the last period).
GetFilePath Procedure Get the folder path part of a string.
GetNextFileName Procedure Generate a new file name that doesn't exist by incrementing the suggested file name until a new one is found.
IsAttributeSet Procedure Determine if the specified attribute is set on the specified file.
KillFile Procedure Delete the named file, handling errors if the file does not exist (same as DeleteFile but provided with a similar name).
DeleteFile Procedure Delete the named file, handling errors if the file does not exist (same as KillFile but provided with a similar name).
DeleteFolderFiles Procedure Delete all the files (with or without a mask) in a folder. Does not modify subfolders and does not delete the folder.
DeleteFolderSubfolder Procedure Delete all the files in a folder without deleting the folder. Optionally delete subfolders or specific file types.
DeleteEmptyFolder Procedure Delete an empty folder.
DeleteFolder Procedure Delete a folder and all its contents.
MakeFolder Procedure Create a folder (directory) if it doesn't already exist. The folder must be in a folder that already exists.
MakeSubFolders Procedure Create a folder (directory) and subfolders if it doesn't already exist. This is improves upon the basic MkDir command which only creates folders in a folder that already exists.
MoveFile Procedure Move the specified file to a new destination. If you use the VBA/VB6 Name function with the same file name for the source and destination arguments, but specify a different directory, the Name function actually moves the file. This procedure uses that behavior to move a file. Note that the destination file must not already exist. Use the FileExists function to determine if the file referenced by strDestination already exists. If so, delete it with the KillFile function.
ParsePath Procedure Parses the passed full path into its component parts.
PurgeFile Procedure Replace a file's contents with space characters for security before deleting it. When you a delete a DOS file (with the Kill command, or though the operating system or the DOS DEL command), its contents are not removed from the disk. Instead, the file is marked as deleted, and the contents remain on the disk until the space is needed by other files. This can lead to a potential security problem. To solve this, you must fill the file with blank contents, and the delete it. This function accomplishes that process.
ReadFileContents Procedure Open the named file and returns its contents as a variant.
ReadFileBytes Procedure Retrieve the specified number of bytes from a file (can be any type of file including binary and text files).
ReadFileText Procedure Read the specified number of characters from a text file.
ReadTextFileToArray Procedure Read a text file into an array of strings.
RenameFile Procedure Rename a file or directory (folder).
SetFileAttributes Procedure Set the specified attributes on the specified file.
GetFileSizeSimple Procedure Get the size of the specified file in bytes without using Windows API calls.

Example Code for Using Module: FileDisk

' Example of modFileDisk
'
' To use this example, create a new module and paste this code into it.
' Then run the procedure by putting the cursor in the procedure and pressing:
'    F5 to run it, or
'    F8 to step through it line-by-line (see the Debug menu for more options)

' This example assumes that the sample files are located in the folder named by the following constant.
Private Const mcstrSamplePath As String = "C:\Total Visual SourceBook 2013\Samples\"

Private Sub Example_modFileDisk()
  ' Comments: Examples of using the features of module modFileDisk for managing files in VBA and VB6.

  Const cstrNewFile As String = mcstrSamplePath & "NEWFILE.TXT"
  Const cstrTestFile As String = mcstrSamplePath & "TESTFILE.TXT"
  Const cstrReadFile As String = mcstrSamplePath & "TESTREADFILE.TXT"
  Const cstrNoLineNums As String = mcstrSamplePath & "NOLINENUMS.TXT"
  Const cstrLineNums As String = mcstrSamplePath & "LINENUMS.TXT"
  Const cstrDestDir As String = mcstrSamplePath & "DESTDIR"
  Const cstrSourceDir As String = mcstrSamplePath & "SOURCEDIR"
  Const cstrMoveDir As String = mcstrSamplePath & "SAMPLEMOVEDIR\"
  Const cintMaxLines As Integer = 10

  Dim fOK As Boolean
  Dim fAttribute As Boolean
  Dim strDrive As String
  Dim strPath As String
  Dim strFileName As String
  Dim strExtension As String
  Dim strMsg As String
  Dim abytIn() As Byte
  Dim astrFiles() As String
  Dim varTmp As Variant
  Dim intFiles As Integer
  Dim intCount As Integer
  Dim intCounter As Integer
  Dim lngBytes As Long
  Dim astrLines() As String

  If IsFolder(mcstrSamplePath) Then
    ' Only proceed if the root folder for these examples exist

    ' ---------------------------------------------------
    ' Clean up files from previous runs of the example code
    If DeleteFile(cstrNewFile) Then
      Debug.Print "File deleted: " & cstrNewFile
    Else
      Debug.Print "File not deleted: " & cstrNewFile
    End If

    If DeleteFile(cstrLineNums) Then
      Debug.Print "File deleted: " & cstrLineNums
    Else
      Debug.Print "File not deleted: " & cstrLineNums
    End If

    ' Delete the files in the folder without deleting the folder
    If DeleteFolderFiles(cstrDestDir) Then
      Debug.Print "Files deleted from " & cstrDestDir
    Else
      Debug.Print "Files were not deleted from " & cstrDestDir
    End If

    ' Delete the files in the folder and any subfolders without deleting the folder
    If DeleteFolderSubfolder(cstrMoveDir, True, True, False) Then
      Debug.Print "Files and subfolders deleted from " & cstrMoveDir
    Else
      Debug.Print "Files and subfolders not deleted from " & cstrMoveDir
    End If
    ' ---------------------------------------------------

    ' Test the AppendToTextFile procedure
    fOK = AppendToTextFile(cstrTestFile, "This is some test text to append.")
    Debug.Print "AppendToTextFile(): returned " & fOK

    ' Copy the contents of one directory to another
    intFiles = CopyDirectory(cstrSourceDir, cstrDestDir)
    Debug.Print "CopyDirectory() copied " & intFiles & " files."

    ' Copy a file
    fOK = CopyFile(cstrTestFile, cstrNewFile)
    Debug.Print "CopyFile(): returned: " & fOK

    ' See if a server folder exists
    If DirectoryExistsUNC("\\folder\common\") Then
      strMsg = "exists"
    Else
      strMsg = "does not exist"
    End If
    Debug.Print "DirectoryExistsUNC(): UNC folder " & strMsg

    ' Try it again with something that doesn't exist
    strMsg = "DirectoryExists(): directory x:\nothere\foobar"
    If DirectoryExists("x:\nothere\foobar") Then
      strMsg = strMsg & " does exist."
    Else
      strMsg = strMsg & " doesn't exist."
    End If
    Debug.Print strMsg

    ' See if a file exists
    strMsg = "FileExists(): file " & cstrTestFile
    If FileExists(cstrTestFile) Then
      strMsg = strMsg & " does exist."
    Else
      strMsg = strMsg & " doesn't exist."
    End If
    Debug.Print strMsg

    ' See again with something we know doesn't exist
    strMsg = "FileExists(): file x:\foobar\FMS\programs\123.456"
    If FileExists("x:\foobar\FMS\programs\123.456") Then
      strMsg = strMsg & " does exist."
    Else
      strMsg = strMsg & " doesn't exist."
    End If
    Debug.Print strMsg
    Debug.Print

    ' Get all the directories in a folder
    intCount = DirectoriesToArray(mcstrSamplePath, False, astrFiles())
    Debug.Print "DirectoriesToArray(): there are " & intCount & " folders in " & mcstrSamplePath & ": " & vbCrLf & Join(astrFiles, ", ")
    Debug.Print

    ' Get all the directories in a folder and its subfolders
    intCount = DirectoriesToArray(mcstrSamplePath, True, astrFiles())
    Debug.Print "DirectoriesToArray(): there are " & intCount & " folders and subfolders in " & mcstrSamplePath & ": " & vbCrLf & Join(astrFiles, ", ")
    Debug.Print

    ' Get all the files in a directory
    intCount = FilesToArray(mcstrSamplePath, "*.*", True, False, astrFiles())
    Debug.Print "FilesToArray(): there are " & intCount & " files in " & mcstrSamplePath & ":" & vbCrLf & Join(astrFiles, ", ")
    Debug.Print

    ' Get all the files in a folder and all its subfolders
    intCount = FilesInSubFoldersToArray(mcstrSamplePath, "*.*", True, False, astrFiles())
    Debug.Print "FilesInSubFoldersToArray(): there are " & intCount & " files in " & mcstrSamplePath & " and its subfolders:" & vbCrLf & Join(astrFiles, ", ")
    Debug.Print

    ' Try to move a file
    fOK = MoveFile(cstrTestFile, cstrMoveDir)
    Debug.Print "MoveFile() moved [" & cstrTestFile & "] to " & cstrMoveDir & ": " & fOK

    ' Get the path part from a full file name
    Debug.Print "GetFilePath() : path part of " & cstrTestFile & " is " & GetFilePath(cstrTestFile)

    ' Get the name part from a full file name
    Debug.Print "GetFileName() : name part of " & cstrTestFile & " is " & GetFileName(cstrTestFile)

    ' Get the name without extension from a full file name
    Debug.Print "GetFileNameNoExt() : name without extension of " & cstrTestFile & " is " & GetFileNameNoExt(cstrTestFile)

    ' Get the extension from a full file name
    Debug.Print "GetFileExtension() : extension of " & cstrTestFile & " is " & GetFileExtension(cstrTestFile)

    ' Get the full file name without the extension
    Debug.Print "GetFullFileNameNoExt() : full name without extension of " & cstrTestFile & " is " & GetFullFileNameNoExt(cstrTestFile)

    ' ---------------------------------------------------
    ' Rename test file
    ' Create new file name from the one to rename
    strFileName = "Renamed_" & GetFileName(cstrNewFile)
    ' Add the folder
    strFileName = GetFilePath(cstrNewFile) & strFileName
    fOK = RenameFile(cstrNewFile, strFileName)
    Debug.Print cstrNewFile & " renamed to: " & strFileName & "_Renamed: " & fOK
    ' ---------------------------------------------------

    ' Delete a test file
    If KillFile(cstrNewFile) Then
      Debug.Print "KillFile(): file " & cstrNewFile & " was deleted."
    Else
      Debug.Print "KillFile(): file " & cstrNewFile & " was deleted."
    End If

    ' Parse a full path
    ParsePath cstrTestFile, strDrive, strPath, strFileName, strExtension
    strMsg = "Drive: " & strDrive & vbCrLf & _
             "Path: " & strPath & vbCrLf & _
             "FileName: " & strFileName & vbCrLf & _
             "Extension: " & strExtension

    Debug.Print "ParsePath(): " & strMsg

    ' Empty a file for security
    If PurgeFile(cstrTestFile) Then
      Debug.Print "PurgeFile(): file purged."
    Else
      Debug.Print "PurgeFile(): file NOT purged."
    End If

    ' Set some file attributes
    Call SetFileAttributes(cstrReadFile, True, True, True, True)

    ' Get the new file attributes
    fAttribute = IsAttributeSet(cstrReadFile, vbNormal)
    Debug.Print "IsAttrSet(): Normal attribute is" & IIf(fAttribute, "", "not") & " set."

    fAttribute = IsAttributeSet(cstrReadFile, vbReadOnly)
    Debug.Print "IsAttrSet(): ReadOnly attribute is" & IIf(fAttribute, "", "not") & " set."

    fAttribute = IsAttributeSet(cstrReadFile, vbHidden)
    Debug.Print "IsAttrSet(): Hidden attribute is" & IIf(fAttribute, "", "not") & " set."

    fAttribute = IsAttributeSet(cstrReadFile, vbSystem)
    Debug.Print "IsAttrSet(): System attribute is" & IIf(fAttribute, "", "not") & " set."

    ' Set the file's attributes back to reasonable values
    Call SetFileAttributes(cstrReadFile, True, False, False, False)
    Debug.Print "SetFileAttr(): restored file attributes"

    ' Add line numbers to a file
    AddLineNumbersToFile cstrNoLineNums, cstrLineNums, 100, 10
    Debug.Print "AddLineNumbersToFile(): " & "Added line numbers from " & cstrNoLineNums & " to " & cstrLineNums

    ' Count lines in text file
    Debug.Print cstrNoLineNums & " has " & CountLinesInTextFile(cstrNoLineNums, False) & " line(s) including blanks, and " & _
      CountLinesInTextFile(cstrNoLineNums, True) & " lines excluding blanks."

    ' Get the next file name similiar to the existing file but incremented:
    Debug.Print "Next available file name for " & cstrNoLineNums & " is: " & GetNextFileName(cstrNoLineNums)

    If FileExists(cstrNoLineNums) Then
      Debug.Print "File size: " & GetFileSizeSimple(cstrNoLineNums)

      ' Read contents of a file into a variable; only show the first 300 characters
      varTmp = ReadFileContents(cstrNoLineNums)
      Debug.Print "ReadFileContents(): file " & cstrNoLineNums & " contains (300 chacters): " & vbCrLf & Left$(varTmp, 300)

      Debug.Print

      Debug.Print "ReadFileText(): file " & cstrNoLineNums & " has these 16 characters starting from character 11: " & vbCrLf & _
                  ReadFileText(cstrNoLineNums, 16, 11)

      Debug.Print "ReadFileText(): file " & cstrNoLineNums & " has these 16 characters starting from character 11: " & vbCrLf & _
                  ReadFileText(cstrNoLineNums, 16, 11)

      ' Read a multi-line text file into an array of lines
      intCount = ReadTextFileToArray(cstrNoLineNums, astrLines)
      Debug.Print intCount & " lines read into the array: "

      ' For this example, just show the first 10 lines
      If intCount > cintMaxLines Then
        intCount = cintMaxLines
      End If
      For intCounter = 0 To intCount - 1
        Debug.Print intCounter, astrLines(intCounter)
      Next intCounter
    Else
      Beep
      Debug.Print "ReadFileContents(): file: " & cstrNoLineNums & " does not exist."
    End If

    ' Read the bytes from a file
    lngBytes = ReadFileBytes(cstrReadFile, 2048, 1, abytIn())
    Debug.Print "ReadFileBytes(): returned " & lngBytes & " bytes from " & cstrReadFile

    MsgBox "Examples of modFileDisk Completed", vbInformation
  Else
    MsgBox "Examples of modFileDisk could not be run since " & mcstrSamplePath & " does not exist. Create the folder then rerun the examples.", vbCritical
  End If
End Sub

Private Sub Example_modFileDisk_Folders()
  ' Comments: Examples of using the folder features of module modFileDisk to create and delete folders, subfolders and their contents

  Dim strNewFolder As String
  Dim strSubFolder As String

  ' New folder name
  strNewFolder = mcstrSamplePath & "My New Folder"

  ' Create the new folder
  If MakeFolder(strNewFolder) Then
    Debug.Print "Created new folder: " & strNewFolder
  Else
    Debug.Print "Could not create new folder: " & strNewFolder
  End If

  ' Create subfolders in the new folder
  strSubFolder = strNewFolder & "\SubFolder\SubSubFolder"
  If MakeSubFolders(strSubFolder) Then
    Debug.Print "Created new subfolder: " & strSubFolder
  End If

  ' Delete the subfolder
  If DeleteFolder(strSubFolder) Then
    Debug.Print "Subfolder deleted: " & strSubFolder
  Else
    Debug.Print "Subfolder not deleted: " & strSubFolder
  End If

  ' Alternatively, one can delete a folder and its subfolders
  If DeleteFolderSubfolder(strNewFolder, True, True, True) Then
    Debug.Print "Folder and subfolders deleted from: " & strNewFolder
  Else
    Debug.Print "Folder and subfolders not deleted from: " & strNewFolder
  End If
End Sub

Private Sub Example_modFileDisk_Drives()
  ' Comments: Examples of using the features of module modFileDisk for checking drives

  Dim strMsg As String
  Dim strDrive As String
  Dim astrDrives() As String
  Dim intCounter As Integer

  ' See if E: drive exists
  strDrive = "E"
  If DriveExists(strDrive) Then
    strMsg = "exists"
  Else
    strMsg = "does not exist"
  End If
  Debug.Print "DriveExists(): Drive " & strDrive & ": " & strMsg

  ' Get all existing drives
  If AvailableDrives(astrDrives) Then
    For intCounter = LBound(astrDrives) To UBound(astrDrives)
      Debug.Print astrDrives(intCounter) & ": drive exists"
    Next intCounter
  End If

End Sub

Microsoft Access Module LibraryOverview of Total Visual SourceBook

The source code in Total Visual SourceBook includes modules and classes for Microsoft Access, Visual Basic 6 (VB6), and Visual Basic for Applications (VBA) developers. Easily add this professionally written, tested, and documented royalty-free code into your applications to simplify your application development efforts.

Additional Resources