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
|
|