VBA equivalent of FoxPro file manipulation functions

Access does not have many native VBA commands to match the file name manipulation functions available in FoxPro so I wrote this small library to replicate them in Visual Basic.

Note that you may wish to alter the error handling code to match your own system. Each of these functions just returns the string "_ERROR_" if it meets an error.

Visual Basic code

Option Explicit

'-- These replicate the FoxPro filename functions in VBA.
'-- They include the failings of the FoxPro functions and these are noted
'-- in comments, for example the inability to recognise a UNC path.

Public Const CHAR_BACKSLASH As String = "\"
Public Const CHAR_COLON As String = ":"
Public Const CHAR_PERIOD As String = "."
Public Const ERROR_STRING As String = "_ERROR_"

'------------------------------------------------------------
Public Function AddBS(strRawPath As String) As String
  ' Description.......: Adds a backslash to a path (if necessary)
  ' Accepts...........: Path name
  ' Returns...........: Path name terminated with "\"
  
  On Error GoTo Err_AddBS

  Dim strLastChar As String
  If Len(strRawPath) = 0 Then
    '-- Do nothing - we don't add a backslash to an empty path
  Else
    strLastChar = Right$(strRawPath, 1)
    If strLastChar = CHAR_BACKSLASH Then
      AddBS = strRawPath
    Else
      AddBS = strRawPath & CHAR_BACKSLASH
    End If
  End If
Exit_AddBS:

  Exit Function

Err_AddBS:
  AddBS = ERROR_STRING
  Resume Exit_AddBS

End Function


'------------------------------------------------------------
Public Function JustExt(strFileName As String) As String
  ' Description.......: Gets the extension from a filename
  ' Accepts...........: File name - with or without an extension or path
  ' Returns...........: The characters after the final period.
  
  '-- FoxPro note
  '-- The JustExt function returns the final extension. If you have "file.xxx.bak" then
  '-- it will return "bak" as the extension.
  
  On Error GoTo Err_JustExt
  
  Dim lngDotPos As Long                    ' Position of the final period in the filename
  
  lngDotPos = InStrRev(strFileName, CHAR_PERIOD)
  If lngDotPos > 0 Then
    JustExt = Mid$(strFileName, lngDotPos + 1)
  Else
    JustExt = ""
  End If

Exit_JustExt:
  Exit Function

Err_JustExt:
  JustExt = ERROR_STRING
  Resume Exit_JustExt
End Function


'------------------------------------------------------------
Public Function JustStem(strPathedName As String) As String
  ' Description.......: Gets the stem name from a filename
  ' Accepts...........: File name - with or without a path
  ' Returns...........: The characters up to the final period.
  
  '-- FoxPro note
  '-- If you have "file.xxx.bak" then it will return "file.xxx" as the stem.
  '-- If you have a badly-formed name such as "file..bak" then this function will
  '-- return "file." as the stem.
    
  On Error GoTo Err_JustStem
  
  Dim lngDotPos As Long                    ' Position of the final period in the filename
  Dim strFileName As String                ' The file name without a path
  
  strFileName = JustFName(strPathedName)
  If strFileName = ERROR_STRING Then
    '-- JustFName has failed so we'll pass the error along
    JustStem = ERROR_STRING
  Else
    lngDotPos = InStrRev(strFileName, CHAR_PERIOD)
    
    If lngDotPos > 0 Then
      JustStem = Left$(strFileName, lngDotPos - 1)
    Else
      JustStem = strFileName
    End If
  End If
  
Exit_JustStem:

  Exit Function

Err_JustStem:
  JustStem = ERROR_STRING
  Resume Exit_JustStem
  
End Function


'------------------------------------------------------------
Public Function JustFName(strPathedName As String) As String
  ' Description.......: Gets the filename from a fully-pathed name
  ' Accepts...........: File name and path
  ' Returns...........: The characters after the final backslash.
  
  On Error GoTo Err_JustFName
  
  Dim lngSlashPos As Long                    ' Position of the final backslash
  lngSlashPos = InStrRev(strPathedName, CHAR_BACKSLASH)
  If lngSlashPos > 0 Then
    JustFName = Mid$(strPathedName, lngSlashPos + 1)
  Else
    JustFName = strPathedName
  End If
  
Exit_JustFName:

  Exit Function

Err_JustFName:
  JustFName = ERROR_STRING
  Resume Exit_JustFName
End Function


'------------------------------------------------------------
Public Function JustPath(strPathedName As String) As String
  ' Description.......: Gets the path from a fully-pathed name
  ' Accepts...........: File name - without a path
  ' Returns...........: The characters up to the final backslash.
                        
  
  '-- FoxPro note
  '-- If the parameter is a file name with no path then this function will
  '-- return an empty string. Perhaps it ought to return "." as the path to the
  '-- current folder.
  
  On Error GoTo Err_JustPath
  
  Dim lngSlashPos As Long                    ' Position of the final backslash
  lngSlashPos = InStrRev(strPathedName, CHAR_BACKSLASH)
  If lngSlashPos > 0 Then
    JustPath = Mid$(strPathedName, 1, lngSlashPos - 1)
  Else
    JustPath = ""
  End If
  
Exit_JustPath:

  Exit Function

Err_JustPath:
  JustPath = ERROR_STRING
  Resume Exit_JustPath
End Function


'------------------------------------------------------------
Public Function JustDrive(strPathedName As String) As String
  ' Description.......: Gets the drive from a fully-pathed name
  ' Accepts...........: File or folder name and path
  ' Returns...........: The letters up to the first backslash
  
  '-- FoxPro note
  '-- The JustDrive function will not recognise a UNC drive such as "\\myLapTop",
  '-- Presumably this is because the FoxPro functions predate the UNC format.
  
  On Error GoTo Err_JustDrive
  
  Dim lngSlashPos As Long                    ' Position of the first backslash
  lngSlashPos = InStr(1, strPathedName, CHAR_BACKSLASH)
  If lngSlashPos > 0 Then
    JustDrive = Left$(strPathedName, lngSlashPos - 1)
  Else
    JustDrive = ""
  End If
  
Exit_JustDrive:

  Exit Function

Err_JustDrive:
  JustDrive = ERROR_STRING
  Resume Exit_JustDrive
End Function


'------------------------------------------------------------
Public Function ForceExt(strFileName As String, strNewExt As String) As String
  ' Description.......: Replaces the existing extension on a filename
  ' Accepts...........: File name - with or without an extension or path
  ' Returns...........: The same name with a new extension
  
  '-- FoxPro notes
  '-- As with JustExt, this will operate on the final extension if you give it a filename
  '-- with two extensions.
  '-- The replacement is not case sensitive. If you ask to add a "doc" extension to
  '-- "FILE.DOC" then the function will assume that it already has a "doc" extension.
  '-- The function does not guarantee that it will generate a valid filename.
  
  On Error GoTo Err_ForceExt
  
  Dim strCurrentExt As String           ' The extension of the given file name
  Dim strPath As String                 ' The path (if any) of the given file name
  Dim strStem As String                 ' The stem of the given file name
  
  strCurrentExt = JustExt(strFileName)
  If UCase(strCurrentExt) = UCase(strNewExt) Then
    '-- We already have the correct extension - possibly of the wrong case.
    ForceExt = strFileName
  Else
    strPath = JustPath(strFileName)
    strStem = JustStem(strFileName)
    ForceExt = AddBS(strPath) & strStem & CHAR_PERIOD & strNewExt
  End If

Exit_ForceExt:
  Exit Function

Err_ForceExt:
  ForceExt = ERROR_STRING
  Resume Exit_ForceExt
End Function


'------------------------------------------------------------
Public Function DefaultExt(strFileName As String, strNewExt As String) As String
  ' Description.......: Adds a default extension to a filename if it's missing
  ' Accepts...........: File name - with or without an extension or path
  ' Returns...........: The same name with a new extension
  
  '-- FoxPro notes
  '-- If the filename ends in a period then the function assumes that it has an extension
  '-- and will not add the default.
  '-- The function does not guarantee that it will generate a valid filename.
  
  On Error GoTo Err_DefaultExt
  
  Dim strCurrentExt As String           ' The extension of the given file name
  
  strCurrentExt = JustExt(strFileName)
  
  If Len(strCurrentExt) > 0 Then
    '-- We already have an extension.
    DefaultExt = strFileName
  Else
    If Right$(strFileName, 1) = CHAR_PERIOD Then
      '-- We have an extension - albeit an empty one
      DefaultExt = strFileName
    Else
      DefaultExt = strFileName & CHAR_PERIOD & strNewExt
    End If
  End If

Exit_DefaultExt:
  Exit Function

Err_DefaultExt:
  DefaultExt = ERROR_STRING
  Resume Exit_DefaultExt
End Function


'------------------------------------------------------------
Public Function ForcePath(strPathedName As String, strNewPath As String) As String
  ' Description.......: Changes the path of a filename
  ' Accepts...........: File name - with or without an extension or path
  '                     The new path - with or without drive or trailing backslash.
  ' Returns...........: The same name with a new path
  
  '-- FoxPro notes
  '-- As with JustExt, this will operate on the final extension if you give it a filename
  '-- with two extensions.
  '-- The replacement is not case sensitive. If you ask to add a "doc" extension to
  '-- "FILE.DOC" then the function will assume that it already has a "doc" extension.
  '-- The function does not guarantee that it will generate a valid filename.
  
  On Error GoTo Err_ForcePath
  
  Dim strCurrentPath As String                 ' The current path of the file
  Dim strFileName As String                    ' The file name without a path
  
  strCurrentPath = JustPath(strPathedName)
  If UCase(AddBS(strCurrentPath)) = UCase(AddBS(strNewPath)) Then
    '-- We already have the correct path - possibly of the wrong case.
    ForcePath = strPathedName
  Else
    strFileName = JustFName(strPathedName)
    ForcePath = AddBS(strNewPath) & strFileName
  End If

Exit_ForcePath:
  Exit Function

Err_ForcePath:
  ForcePath = ERROR_STRING
  Resume Exit_ForcePath
End Function