|
Visual Basic (VB and VBA) |
|
Copyright 1999-2001 Christopher Greaves. All rights reserved. Home Page and email to [email protected] |
| If in doubt, record a macro and inspect the entrails! |
Please read the DISCLAIMER.
Here is an INDEX to all the procedures.
You will probably need one copy of my GLOBAL DECLARATIONS.
Public Function strBreakFileString(strFileName As String, intType As Integer) As String
' Procedure : strBreakFileString
' Description: This code attempts to return the specified portion of a file path and name.
' Useful to
' Copyright: Chris Greaves Inc.
' Inputs: A string, vaguely representing a file path and name.
' An integer specifying the type of string to be returned.
' Returns: A string.
' intType = 0 -- Returns the drive letter
' intType = 1 -- Returns the directory path
' intType = 2 -- Returns the filename (without the extension)
' intType = 3 -- Returns the extension
' intType = 4 -- Returns the filename and extension
' intType = 5 -- Returns the drive and path
' Assumes: The incoming string has been vetted for character content, but not syntax.
' Side Effects: See the accompanying note in the module Readme.
' Tested: By the calls shown below.
'Const strcDriveSeparator As String = ":"
'Const strcPathSeparator As String = "\"
'Const strcExtentSeparator As String = "."
Dim strDrive As String
strDrive = ""
Dim strPath As String
strPath = ""
Dim strFile As String
strFile = ""
Dim strExtent As String
strExtent = ""
Dim lngI As Long ' Pointer along our string. when lngI > len(strFilename) we have finished.
lngI = 1
Dim strCH As String ' The latest character delivered by lngI
Dim strAccum As String ' The accumulated characters buffered to date.
strAccum = ""
Dim intErr As Integer
Null0:
If lngI > Len(strFileName) Then GoTo Exit9
strCH = Mid(strFileName, lngI, 1): lngI = lngI + 1
If boolAlphaOnly(strCH) Then
strAccum = strAccum & strCH
GoTo IsDrive1
Else
If strCH = strcDriveSeparator Then
intErr = 1
GoTo Exit9
Else
If strCH = Application.PathSeparator Then
strPath = strPath & strAccum
strAccum = ""
GoTo GotSlash4
Else
If strCH = strcExtentSeparator Then
strAccum = strAccum & strCH
GoTo GotPeriod5
Else
strAccum = strAccum & strCH
GoTo AccumFile3
End If
End If
End If
End If
IsDrive1:
If lngI > Len(strFileName) Then GoTo Exit9
strCH = Mid(strFileName, lngI, 1): lngI = lngI + 1
If strCH = strcDriveSeparator Then
strDrive = strAccum: strAccum = ""
GoTo GotDrive2
Else
If strCH = Application.PathSeparator Then
If strPath <> "" Then
strPath = strPath & Application.PathSeparator
End If
strPath = strPath & strAccum: strAccum = ""
GoTo GotSlash4
Else
If strCH = strcExtentSeparator Then
strAccum = strAccum & strCH
GoTo GotPeriod5
Else
strAccum = strAccum & strCH
GoTo AccumFile3
End If
End If
End If
GotDrive2:
If lngI > Len(strFileName) Then GoTo Exit9
strCH = Mid(strFileName, lngI, 1): lngI = lngI + 1
If strCH = strcDriveSeparator Then
intErr = 2
GoTo Exit9
Else
If strCH = Application.PathSeparator Then
If strPath <> "" Then
strPath = strPath & Application.PathSeparator
End If
strPath = strPath & strAccum: strAccum = ""
GoTo GotSlash4
Else
If strCH = strcExtentSeparator Then
strAccum = strAccum & strCH
GoTo GotPeriod5
Else
strAccum = strAccum & strCH
GoTo AccumFile3
End If
End If
End If
AccumFile3:
If lngI > Len(strFileName) Then GoTo Exit9
strCH = Mid(strFileName, lngI, 1): lngI = lngI + 1
If strCH = strcDriveSeparator Then
intErr = 3
GoTo Exit9
Else
If strCH = Application.PathSeparator Then
If strPath <> "" Then
strPath = strPath & Application.PathSeparator
End If
strPath = strPath & strAccum: strAccum = ""
GoTo GotSlash4
Else
If strCH = strcExtentSeparator Then
strAccum = strAccum & strCH
GoTo GotPeriod5
Else
strAccum = strAccum & strCH
GoTo AccumFile3
End If
End If
End If
GotSlash4:
If lngI > Len(strFileName) Then GoTo Exit9
strCH = Mid(strFileName, lngI, 1): lngI = lngI + 1
If strCH = strcDriveSeparator Then
intErr = 4
GoTo Exit9
Else
If strCH = Application.PathSeparator Then
intErr = 5
GoTo Exit9
Else
If strCH = strcExtentSeparator Then
strAccum = strAccum & strCH
GoTo GotPeriod5
Else
strAccum = strAccum & strCH
GoTo AccumFile3
End If
End If
End If
GotPeriod5:
If lngI > Len(strFileName) Then GoTo Exit9
strCH = Mid(strFileName, lngI, 1): lngI = lngI + 1
If strCH = strcDriveSeparator Then
intErr = 6
GoTo Exit9
Else
If strCH = Application.PathSeparator Then
If strPath <> "" Then
strPath = strPath & Application.PathSeparator
End If
strPath = strPath & strAccum: strAccum = ""
GoTo GotSlash4
Else
If strCH = strcExtentSeparator Then
intErr = 7
GoTo Exit9
Else
strAccum = strAccum & strCH
GoTo InExtent6
End If
End If
End If
InExtent6:
If lngI > Len(strFileName) Then GoTo Exit9
strCH = Mid(strFileName, lngI, 1): lngI = lngI + 1
If strCH = strcDriveSeparator Then
intErr = 8
GoTo Exit9
Else
If strCH = Application.PathSeparator Then
If strPath <> "" Then
strPath = strPath & Application.PathSeparator
End If
strPath = strPath & strAccum: strAccum = ""
GoTo GotSlash4
Else
If strCH = strcExtentSeparator Then
intErr = 9
GoTo Exit9
Else
strAccum = strAccum & strCH
GoTo InExtent6
End If
End If
End If
Exit9:
If intErr > 0 Then
'MsgBox intErr
strBreakFileString = ""
Else
' At the end, if the last valid character processed was a slash, then we have no file
If strCH = Application.PathSeparator Then
strPath = strPath & strAccum
Else
strFile = strAccum
If InStr(1, strFile, strcExtentSeparator) > 0 Then
strExtent = Right(strFile, Len(strFile) - InStr(1, strFile, strcExtentSeparator))
strFile = Left(strFile, InStr(1, strFile, strcExtentSeparator) - 1)
Else
strExtent = ""
End If
End If
Select Case intType
Case 0
strBreakFileString = strDrive & strcDriveSeparator
Case 1
strBreakFileString = strPath
Case 2
strBreakFileString = strFile
Case 3
strBreakFileString = strExtent
Case 4
If strExtent = "" Then
strBreakFileString = strFile
Else
strBreakFileString = strFile & strcExtentSeparator & strExtent
End If
Case 5
If strDrive = "" Then
strBreakFileString = strPath
Else
strBreakFileString = strDrive & strcDriveSeparator & Application.PathSeparator & strPath & Application.PathSeparator
End If
Case Else
strBreakFileString = ""
End Select
End If
'Sub TESTstrBreakFileString()
'MsgBox strBreakFileString("d:\my documents\all this.txt", intcDrive) ' "d:"
'MsgBox strBreakFileString("d:\my documents\all this.txt", intcPath) ' "my documents"
'MsgBox strBreakFileString("d:\my documents\all this.txt", intcName) ' "all this"
'MsgBox strBreakFileString("d:\my documents\all this.txt", intcExtent) ' "txt"
''MsgBox strBreakFileString("d:\my documents\all.txt", intcName)
'End Sub
End Function
| We all knew nothing when we started … |
|
Home Page and Contact Information Send email to [email protected]. This page was last updated Thursday, November 15, 2001 |