Do you often need to manipulate filenames in VBA ?
Here’s a small set of very useful functions that I regularly use:
GetFileExt
|
1 |
Public Function GetFileExt(ByRef psFilename As String) As String |
Get the file extension part of a filename, without the leading dot (“.”).
Example (type in immediate window):
|
1 2 3 4 |
?GetFileExt("test.txt") txt ?GetFileExt("https://www.example.com/index.html") html |
StripFileExt
|
1 |
Public Function StripFileExt(ByRef psFilename As String) As String |
Get the left part of a filename (and path), without the file extension part.
Example (type in immediate window):
|
1 2 3 4 5 6 |
?StripFileExt("test.txt") test ?StripFileExt("C:\mypath\test.txt") C:\mypath\test ?StripFileExt("https://www.example.com/index.html") https://www.example.com/index |
StripFilePath
|
1 |
Public Function StripFilePath(ByVal psFilename As String) As String |
Get only the filename of a full or partial filename and path.
Example (type in immediate window):
|
1 2 3 4 |
?StripFilePath("C:\mypath\test.txt") test.txt ?StripFilePath("https://www.example.com/index.html") index.html |
StripFileName
|
1 |
Public Function StripFileName(ByVal psFilename As String) As String |
Get only the denormalized(*) path of a full or partial filename and path.
Example (type in immediate window):
|
1 2 3 4 5 6 |
?StripFileName("C:\mypath\test.txt") test.txt ?StripFileName("\a.txt") 'Note: root directory is returned as empty string. ?StripFileName("https://www.example.com/index.html") https://www.example.com |
(*)denormalized: without a path separator (“\”) at the end.
ChangeExt
|
1 |
Public Function ChangeExt(ByVal psFilename As String, ByVal psNewExt As String) As String |
Change the current extension of a filename (ex. “pdf” in c:\temp\test.pdf) to the specified new extension, and return the new filename.
Example (type in immediate window):
|
1 2 3 4 |
?ChangeExt("c:\temp\test.pdf", "txt") c:\temp\test.txt ?ChangeExt("pdf", "txt") pdf.txt |
Code
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 |
'Notes: ' - These functions work on filenames, and as it happens also on urls; ' - Put these declarations in the declaration section of a standard (.bas) module; Private Const PATH_SEP As String = "\" Private Const PATH_SEP_INV As String = "/" Private Const EXT_SEP As String = "." Private Const DRIVE_SEP As String = ":" 'Add these functions definitions in the same standard module. Public Function GetFileExt(ByRef psFilename As String) As String Dim lLen As Long Dim i As Long Dim sChar As String 'Going backwards to find the first EXT_SEP char (or any other path separator) lLen = Len(psFilename): i = lLen If i Then sChar = Mid$(psFilename, i, 1&) Do While (i > 0&) And (sChar <> PATH_SEP) And (sChar <> EXT_SEP) And (sChar <> PATH_SEP_INV) i = i - 1&: If i = 0& Then Exit Do sChar = Mid$(psFilename, i, 1&) Loop If (i > 0&) And (sChar = EXT_SEP) Then GetFileExt = Right$(psFilename, lLen - i) End If End If End Function Public Function StripFileExt(ByRef psFilename As String) As String Dim lLen As Long Dim i As Long Dim sChar As String lLen = Len(psFilename): i = lLen If i Then sChar = Mid$(psFilename, i, 1&) Do While (i > 0&) And (sChar <> PATH_SEP) And (sChar <> EXT_SEP) And (sChar <> PATH_SEP_INV) i = i - 1&: If i = 0& Then Exit Do sChar = Mid$(psFilename, i, 1) Loop If (i > 0) And (sChar = EXT_SEP) Then StripFileExt = Left$(psFilename, i - 1&) Else StripFileExt = psFilename End If End If End Function Public Function StripFilePath(ByVal psFilename As String) As String Dim i As Long Dim sChar As String i = Len(psFilename) If i Then sChar = Mid$(psFilename, i, 1) While (sChar <> DRIVE_SEP) And (sChar <> PATH_SEP) And (sChar <> PATH_SEP_INV) And (i > 0) i = i - 1& If i Then sChar = Mid$(psFilename, i, 1) Else sChar = PATH_SEP End If Wend If i Then StripFilePath = Right$(psFilename, Len(psFilename) - i) Else StripFilePath = psFilename End If End If End Function Public Function StripFileName(ByVal psFilename As String) As String Dim i As Long Dim fLoop As Boolean Dim sChar As String * 1 i = Len(psFilename) If i Then fLoop = True While fLoop If i > 0 Then sChar = Mid$(psFilename, i, 1) If (sChar = PATH_SEP) Or (sChar = DRIVE_SEP) Or (sChar = PATH_SEP_INV) Then fLoop = False End If If i > 1& Then i = i - 1& Else i = 0& fLoop = False End If Wend If i Then StripFileName = Left$(psFilename, i) Else StripFileName = "" End If End Function Public Function ChangeExt(ByVal psFilename As String, ByVal psNewExt As String) As String Dim iLen As Integer Dim i As Integer Dim sChar As String If Left$(psNewExt, 1) = EXT_SEP Then psNewExt = Right$(psNewExt, Len(psNewExt) - 1) 'be forgiving iLen = Len(psFilename) i = iLen If i Then sChar = Mid$(psFilename, i, 1) Do While (i > 0) And (sChar <> PATH_SEP) And (sChar <> EXT_SEP) And (sChar <> PATH_SEP_INV) i = i - 1 If i > 0 Then sChar = Mid$(psFilename, i, 1) End If Loop If (i > 0) And (sChar = EXT_SEP) Then psFilename = Left$(psFilename, i - 1) End If End If ChangeExt = psFilename & EXT_SEP & psNewExt End Function |
Recent Comments