' 1) Create a new project. Form1 will be created by default.
' 2) Add a Textbox to the top of the form. Set the Textbox width to about 6500 or so.
' 3) Stack 6 Labels under the Textbox. Each Label should be the same width as the Textbox.
' 4) Place a Command Button under the Labels.
' 5) Paste the following code into the declarations section of Form1:
' --- Begin code for Form1 ---
'Useful routines for parsing path names
'Jon Vote
'02/2002
Option Explicit
Private Sub Command1_Click()
Dim strPathName As String
strPathName = Trim$(Text1.Text)
Label1.Caption = "Parsing " & Text1.Text & " :"
Label2.Caption = Space$(5) & "JustThePath = " & JustThePath(strPathName)
Label3.Caption = Space$(5) & "JustThefile = " & JustThefile(strPathName)
Label4.Caption = Space$(5) & "StripFileExtension = " & StripFileExtension(strPathName)
Label5.Caption = Space$(5) & "StripDrive = " & StripDrive(strPathName)
Label6.Caption = Space$(5) & "JustTheExtension = " & JustTheExtension(strPathName)
End Sub
Private Sub Form_Load()
Dim ctlControl As Control
Me.Caption = "Useful string routines for parsing path names"
Command1.Caption = "&Parse"
Command1.Default = True
'Default to the path we are running in
Text1.Text = PutSlash(App.Path) & App.EXEName & ".exe"
'Clear the labels
For Each ctlControl In Me.Controls
If TypeOf ctlControl Is Label Then
ctlControl.Caption = ""
End If
Next ctlControl
End Sub
' --- End code for Form1 ---
' 6) From the menu select Project|Add Module. Module1 will be created by default
' 7) Paste the followin code into Module1:
' --- Begin code for Module1 ---
Option Explicit
'JustThePath - Returns just the path name without the file.
'C:\Path1\Path2\File.txt => C:\Path1\Path2\
Public Function JustThePath(ByVal strPathName As String) As String
Dim s As Integer
s = InStrRev(strPathName, "\")
If s > 0 Then
JustThePath = Left$(strPathName, s)
Else
JustThePath = ""
End If
End Function
'JustTheFile - Returns just the file name without the file.
'C:\Path1\Path2\File.txt => File1.txt
Public Function JustThefile(ByVal strPathName As String) As String
Dim s As Integer
s = InStrRev(strPathName, "\")
If s > 0 Then
JustThefile = Mid$(strPathName, s + 1)
Else
JustThefile = strPathName
End If
End Function
'StripFileExtension - Strips the file extension from a path name
'C:\Path1\Path2\File1.txt => C:\Path1\Path2\File
Public Function StripFileExtension(ByVal strPathName As String) As String
Dim s As Integer
s = InStrRev(strPathName, ".")
If s > 0 Then
StripFileExtension = Left$(strPathName, s - 1)
Else
StripFileExtension = strPathName
End If
End Function
'StripDrive - Strips the Drive or Network Share name from the path name
'C:\Path1\Path2\File1.txt => \Path1\Path2\File1.txt
'\\Share\Path1\Path2\File1.txt => \Path1\Path2\File1.txt
Public Function StripDrive(ByVal strPathName) As String
Dim s As Integer
Dim t As Integer
s = InStr(strPathName, ":")
If s = 0 Then
s = InStrRev(strPathName, "\\")
If s <> 0 Then
t = InStr(s + 2, strPathName, "\")
If t > 0 Then
s = t - 1
Else
s = Len(strPathName)
End If
End If
End If
If s > 0 Then
StripDrive = Mid$(strPathName, s + 1)
Else
StripDrive = strPathName
End If
End Function
'JustTheExtension - Returns only the file extension of a file name
'C:\Path1\Path2\File1.txt => txt
Public Function JustTheExtension(ByVal strPathName As String) As String
Dim s As Integer
s = InStrRev(strPathName, ".")
If s > 0 Then
JustTheExtension = Mid$(strPathName, s + 1)
Else
JustTheExtension = ""
End If
End Function
'PutSlash - Insures there is a closing backslash for a path name
'C:\Path1\Path2 => C:\Path1\Path2\
Public Function PutSlash(ByVal strPathName As String) As String
If Right$(strPathName, 1) <> "\" Then
PutSlash = strPathName & "\"
Else
PutSlash = strPathName
End If
End Function
' --- End code for Module1 ---