image
 
image
M021_File.bas


' ========================================================================================================================
'                                 ____,__,  __,  ____,_,  _,  ____ ____,__, ,____,____,
'                                (-/_|(-|  (-|  (-|_,(-|\ |  (-|__|-/_|( |_/(-|_,(-|__)
'                                _/  |,_|__,_|__,_|__,_| \|,  _|__)/  |,_| \,_|__,_|  \,
'
'                                             Copyright � 2009 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File:          M021_File
' Originator:    Allen Baker (2009.11.21 15:54)
' ------------------------------------------------------------------------------------------------------------------------
' $RCSfile$
' $Revision$
' $Date$
' ========================================================================================================================
'
Option Explicit



' ========================================================================================================================
' Description
'    This module provides procedures that supplement the File type.
' ========================================================================================================================



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Constants  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[  Miscellaneous  ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function opens an XLS file. It displays the File Open box. You can naviagate to a directory, select
' the file and then click Open. The file you selected will open up in Excel.
' -----------------------------------------------------------------------------------------------------------
Public Function openXLSFile()
   openXLSFile = openFile("XLS")
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function opens an CSV file. It displays the File Open box. You can naviagate to a directory, select
' the file and then click Open. The file you selected will open up in Excel.
' -----------------------------------------------------------------------------------------------------------
Public Function openCSVFile() As String
   openCSVFile = openFile("CSV")
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function opens a file. It displays the File Open box. You can naviagate to a directory, select the
' file and then click Open. The file you selected will open up in Excel.
'
' return
'    this function returns the name of the file that was opened
'
' param
'    pFileType is a string that specifies the file extension for the file to open.
' -----------------------------------------------------------------------------------------------------------
Public Function openFile(pFileType As String) As String
   Dim fileName       As Variant
   Dim fileNameString As String
   Dim fileType       As String
   gMsg(1) = ""
   fileType = UCase(pFileType)
   '
   ' ==============================================================================================
   ' display the file open box
   ' ----------------------------------------------------------------------------------------------
   Select Case fileType
      Case "XLS"
         fileName = Application.GetOpenFilename(FileFilter:="Excel Text Files (*.csv), *.csv", Title:="Please select a file")
      Case "CSV"
         fileName = Application.GetOpenFilename(FileFilter:="Excel Text Files (*.csv), *.csv", Title:="Please select a file")
      Case Else
         fileName = Application.GetOpenFilename(FileFilter:="All Files (*.*), *.*", Title:="Please select a file")
   End Select
   '
   ' ==============================================================================================
   ' if they did not select a file (they pressed cancel), just exit
   ' ----------------------------------------------------------------------------------------------
   If fileName = False Then
      openFile = ""
   '
   ' ==============================================================================================
   ' otherwise they did select a file so open it.
   ' ----------------------------------------------------------------------------------------------
   Else
      fileNameString = fileName
      openFile = openNamedFile(fileNameString)
   End If
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function opens a specified file.
'
' return
'    this function returns the name of the file that was opened or if the file does not exist, it returns
'    the empty string.
'
' param
'    pFileType is a string that specifies the filename of the file to open.
' -----------------------------------------------------------------------------------------------------------
Public Function openNamedFile(pFilePath As String) As String
   gMsg(1) = ""
   On Error GoTo ErrHandler
   If fileExists(pFilePath) Then
      Workbooks.Open fileName:=pFilePath
      openNamedFile = pFilePath
   Else
      gMsg(1) = "openNamedFile(" & pFilePath & "): File does not exist."
      openNamedFile = ""
   End If
   Exit Function
ErrHandler:
   gMsg(1) = "openNamedFile(" & pFilePath & "): " & Err.Description
   openNamedFile = ""
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function deletes all the files that match a filename spec.  deleteFile supports the use of
' multiple-character (*) and single-character (?) wildcards to specify multiple files
'
' return
'    True if all matching files are deleted, False if not.
'
' param
'    pFilePathSpec is a string expression that specifies one or more filenames to be deleted. pFilePathSpec
'    may include the directory or folder and the drive
' -----------------------------------------------------------------------------------------------------------
Public Function deleteFile(pFilePathSpec As String) As Boolean
   gMsg(1) = ""
   On Error GoTo ErrHandler
   Kill pFilePathSpec
   deleteFile = Not fileExists(pFilePathSpec)
   If Not deleteFile Then gMsg(1) = "deleteFile(" & pFilePathSpec & "): Delete failed."
   Exit Function
ErrHandler:
   gMsg(1) = "deleteFile(" & pFilePathSpec & "): " & Err.Description
   deleteFile = False
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function renames the specified file.  renameFile does not support the use of multiple-character (*)
' and single-character (?) wildcards to specify multiple files
'
' return
'    True if the file was successfully renamed, False if not.
'
' param
'    pOldFilePath is the pathname of the file to rename.
' param
'    pNewFilePath is the pathname to rename the file to.
' -----------------------------------------------------------------------------------------------------------
Public Function renameFile(pOldFilePath As String, pNewFilePath As String) As Boolean
   gMsg(1) = ""
   On Error GoTo ErrHandler
   Name pOldFilePath As pNewFilePath
   renameFile = (Not fileExists(pOldFilePath)) And (fileExists(pNewFilePath))
   If Not renameFile Then gMsg(1) = "renameFile(" & pOldFilePath & "  " & pNewFilePath & "): Rename failed."
   Exit Function
ErrHandler:
   gMsg(1) = "renameFile: " & Err.Description
   renameFile = False
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function copys the specified file.  copyFile does not support the use of multiple-character (*) and
' single-character (?) wildcards to specify multiple files
'
' return
'    True if the file was successfully copied, False if not.
'
' param
'    pSourceFilePath is the pathname of the file to copy.
' param
'    pDestinationFilePath is the pathname to copy the file to.
' -----------------------------------------------------------------------------------------------------------
Public Function copyFile(pSourceFilePath As String, pDestinationFilePath As String) As Boolean
   gMsg(1) = ""
   On Error GoTo ErrHandler
   Call FileCopy(pSourceFilePath, pDestinationFilePath)
   copyFile = _
      ( _
      fileExists(pSourceFilePath) And _
      fileExists(pDestinationFilePath) And _
      filesAreEqual(pSourceFilePath, pDestinationFilePath) _
      )
   If Not copyFile Then gMsg(1) = "copyFile(" & pSourceFilePath & "  " & pDestinationFilePath & "): Copy failed."
   Exit Function
ErrHandler:
   gMsg(1) = "copyFile: " & Err.Description
   copyFile = False
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine accepts two strings that represent two files to compare. A return value of True indicates
' that the contents of the files are the same. A return value of False indicates that the files are not the
' same.
'
' return
'    True if the files are equal, False if not.
'
' param
'    pFilePath1 is the pathname of the file to compare to the file at pFilePath2
' param
'    pFilePath2 is the pathname of the file to compare to the file at pFilePath1
' -----------------------------------------------------------------------------------------------------------
Public Function filesAreEqual(pFilePath1 As String, pFilePath2 As String) As Boolean
   Const cChunkSize     As Long = 1000
   Dim   file1          As Integer
   Dim   file2          As Integer
   Dim   numChunks      As Long
   Dim   bytesRemaining As Long
   Dim   thisChunk      As Long
   Dim   buffer1        As String * cChunkSize
   Dim   buffer2        As String * cChunkSize
   gMsg(1) = ""
   '
   ' ==============================================================================================
   ' if the filenames passed in are not empty, open the files
   ' ----------------------------------------------------------------------------------------------
   If Len(Dir$(pFilePath1)) > 0 And Len(Dir$(pFilePath2)) > 0 Then
   On Error GoTo ErrFailed
      file1 = FreeFile
      Open pFilePath1 For Binary Access Read As file1
      file2 = FreeFile
      Open pFilePath2 For Binary Access Read As file2
      '
      ' ==============================================================================================
      ' Files are a different size
      ' ----------------------------------------------------------------------------------------------
      If LOF(file1) <> LOF(file2) Then
         filesAreEqual =   False
      '
      ' ==============================================================================================
      ' Files are same size
      ' ----------------------------------------------------------------------------------------------
      Else
         numChunks = LOF(file1) \ cChunkSize
         bytesRemaining = LOF(file1) Mod cChunkSize       'Remaining number of bytes
         '
         ' ==============================================================================================
         ' Loop over the files reading in chunks of data and comparing them
         ' ----------------------------------------------------------------------------------------------
         For   thisChunk = 1 To numChunks
            Get file1, cChunkSize * (thisChunk - 1) + 1, buffer1
            Get file2, cChunkSize * (thisChunk - 1) + 1, buffer2
            '
            ' ==============================================================================================
            ' Files are different
            ' ----------------------------------------------------------------------------------------------
            If Not (buffer1 = buffer2) Then
               filesAreEqual = False
               Exit For
            End If
         Next
         '
         ' ==============================================================================================
         ' Check last chunk of data
         ' ----------------------------------------------------------------------------------------------
         If thisChunk = numChunks + 1 Then
            Get file1, (cChunkSize * numChunks) + 1, buffer1   'get the bytesRemaining bytes at the end
            Get file2, (cChunkSize * numChunks) + 1, buffer2   'get the bytesRemaining bytes at the end
            '
            ' ==============================================================================================
            ' Files are different
            ' ----------------------------------------------------------------------------------------------
            If Not Left$(buffer1, bytesRemaining) = Left$(buffer2, bytesRemaining) Then
               filesAreEqual = False
            '
            ' ==============================================================================================
            ' File are identical
            ' ----------------------------------------------------------------------------------------------
            Else
               filesAreEqual = True
            End If
         End If
      End If
      '
      ' ==============================================================================================
      ' Close files
      ' ----------------------------------------------------------------------------------------------
      Close file1
      Close file2
   '
   ' ==============================================================================================
   ' Files don't exist
   ' ----------------------------------------------------------------------------------------------
   Else
      filesAreEqual = False
   End If
   Exit Function

ErrFailed:
   gMsg(1) = "filesAreEqual: " & Err.Description
   filesAreEqual = False
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function checks to see if any files matching the filename spec exist.  If any do, then this function
' returns true, otherwise, it returns False.  fileExists supports the use of multiple-character (*) and
' single-character (?) wildcards to specify multiple files
'
' return
'    True if any matching files exist, False if not.
'
' param
'    pFilePathSpec is a string expression that specifies one or more filenames to look for. pFilePathSpec
'    may include the directory or folder and the drive
' -----------------------------------------------------------------------------------------------------------
Public Function fileExists(pFilePathSpec As String) As Boolean
   fileExists = (Dir$(pFilePathSpec, vbNormal + vbHidden + vbSystem) <> vbNullString)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function checks to see if any directories matching the directory path spec exist.  If any do, then
' this function returns true, otherwise, it returns False.  directoryExists supports the use of
' multiple-character (*) and single-character (?) wildcards to specify multiple directories
'
' return
'    True if any matching directories exist, False if not.
'
' param
'    pDirPathSpec is a string expression that specifies one or more directory paths to look for.
'    pDirPathSpec may include the directory or folder and the drive
' -----------------------------------------------------------------------------------------------------------
Public Function directoryExists(pDirPathSpec As String) As Boolean
   directoryExists = (Dir$(pDirPathSpec, vbDirectory + vbHidden + vbSystem) <> vbNullString)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function strips away the path from a filename giving the workbook name of the file
'
' return
'    this function returns a workbook name
'
' param
'    pFilePath is the pathname of the file from which a wookbook name is derived
' -----------------------------------------------------------------------------------------------------------
Public Function workbookNameFromFileName(pFilePath As String) As String
   Dim idx As Long
   idx = InStrRev(pFilePath, "\")
   workbookNameFromFileName = Right(pFilePath, Len(pFilePath) - idx)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function strips away the extension from a filename
'
' return
'    this function returns an extensionless name
'
' param
'    pFilePath is the pathname of the file from which extension is removed
' -----------------------------------------------------------------------------------------------------------
Public Function extensionlessFileName(pFilePath As String) As String
   Dim idx As Long
   idx = InStrRev(pFilePath, ".")
   extensionlessFileName = Left(pFilePath, idx - 1)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function strips away the directory path from a filename
'
' return
'    this function returns an directoryless name
'
' param
'    pFilePath is the pathname of the file from which the directory path is removed
' -----------------------------------------------------------------------------------------------------------
Public Function directorylessFileName(pFilePath As String) As String
    directorylessFileName = Mid(pFilePath, InStrRev(pFilePath, "\") + 1)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function strips away the extension from a filename and also strips away the directory path from the
' fron of the filename.
'
' return
'    this function returns an extensionless and directoryless name
'
' param
'    pFilePath is the pathname of the file from which extension and directory is removed
' -----------------------------------------------------------------------------------------------------------
Public Function directorylessAndExtensionlessFileName(pFilePath As String) As String
    Dim strTemp As String
    strTemp = Mid(pFilePath, InStrRev(pFilePath, "\") + 1)
    directorylessAndExtensionlessFileName = Left(strTemp, InStrRev(strTemp, ".") - 1)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function gets the extension portion of a filename
'
' return
'    this function returns filename's extension
'
' param
'    pFilePath is the pathname of the file from which extension is removed
' -----------------------------------------------------------------------------------------------------------
Public Function fileNameExtension(pFilePath As Variant) As String
    Dim strTemp  As String
    Dim strTemp2 As String
    Dim intPos   As Integer
    If IsNull(pFilePath) Then
        strTemp = ""
    Else
        strTemp2 = pFilePath
        intPos = InStrRev(strTemp2, ".")
        If intPos = 0 Then
            strTemp = ""
        Else
            If intPos = Len(strTemp2) Then
                strTemp = ""
            Else
                strTemp = Mid(strTemp2, intPos + 1)
            End If
        End If
    End If
    fileNameExtension = strTemp
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function gets the folder portion (i.e. the directory path only) of a filename
'
' return
'    this function returns filename's folder
'
' param
'    pFilePath is the pathname of the file from which folder is returned
' -----------------------------------------------------------------------------------------------------------
Public Function folder(pFilePath As String) As String
   folder = Left(pFilePath, InStrRev(pFilePath, "\"))
End Function