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

' 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

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.

Total Visual SourceBook is written for the needs of a developer using a source code library covering the many challenges you face. Countless developers over the years have told us they learned some or much of their development skills and tricks from our code. You can too!

Additional Resources

• List of All Modules in Total Visual SourceBook
• List of All Code Categories in Total Visual SourceBook
• Sample Module Code from Total Visual SourceBook (Example of Date, Time and Age Calculations)