|
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 strBreakFileString1(strSource As String, intType As Integer) As String
Dim lPos1 As Long
Dim lPos2 As Long
Dim i As Long
Dim strForwardSlash As String
strBreakFileString1 = ""
If strSource = "" Then
Exit Function
End If
' Replace back slashes with forward, just in case the worng one has been used
strForwardSlash = strSource
' If Office 2000, this loop could be replaced by "Replace"
For i = 1 To Len(strSource)
If Mid$(strForwardSlash, i, 1) = "\" Then
Mid$(strForwardSlash, i, 1) = "/"
End If
Next
Select Case intType
Case intcDrive
lPos1 = InStr(strSource, ":")
If lPos1 > 0 Then
strBreakFileString1 = Mid$(strSource, 1, lPos1)
End If
Case intcPath
lPos1 = InStr(strSource, ":")
If lPos1 = 0 Then
lPos1 = 1
End If
lPos2 = inStrLast(strForwardSlash, "/")
If lPos2 > lPos1 Then
If Mid$(strForwardSlash, lPos1 + 1, 1) = "/" Then
strBreakFileString1 = Mid$(strSource, lPos1 + 2, lPos2 - lPos1 - 2)
Else
strBreakFileString1 = Mid$(strSource, lPos1 + 1, lPos2 - lPos1 - 1)
End If
End If
Case intcName
lPos1 = inStrLast(strForwardSlash, "/")
lPos2 = inStrLast(strSource, strcExtentSeparator)
If lPos2 > lPos1 Then
strBreakFileString1 = Mid$(strSource, lPos1 + 1, lPos2 - lPos1 - 1)
End If
Case intcExtent
lPos1 = inStrLast(strSource, strcExtentSeparator)
If lPos1 > 0 Then
strBreakFileString1 = Mid$(strSource, lPos1 + 1)
End If
End Select
'Sub TESTstrBreakFileString1()
'MsgBox strBreakFileString1("d:\my documents\all this.txt", intcDrive) ' "d:"
'MsgBox strBreakFileString1("d:\my documents\all this.txt", intcPath) ' "my documents"
'MsgBox strBreakFileString1("d:\my documents\all this.txt", intcName) ' "all this"
'MsgBox strBreakFileString1("d:\my documents\all.txt", intcName)
'MsgBox strBreakFileString1("d:\my documents\all this.txt", intcExtent) ' "txt"
'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 |