VBA/Excel/Access/Word/File Path/File Name
Get file name
<source lang="vb">
Sub GetFileName()
Dim BackSlash As Integer, Point As Integer Dim FilePath As String, FileName As String Dim i As Integer FilePath = "c:\a\b.xls" For i = Len(FilePath) To 1 Step -1 If Mid$(FilePath, i, 1) = "." Then Point = i Exit For End If Next i If Point = 0 Then Point = Len(FilePath) + 1 For i = Point - 1 To 1 Step -1 If Mid$(FilePath, i, 1) = "\" Then BackSlash = i Exit For End If Next i FileName = Mid$(FilePath, BackSlash + 1, Point - BackSlash - 1) MsgBox FileName
End Sub
</source>
Get short file name
<source lang="vb">
Sub Main()
Debug.Print GetShortName("c:a\a\a.xls")
End Sub Function GetShortName(sLongName As String) As String
Dim sPath As String Dim sShortName As String BreakdownName sLongName, sShortName, sPath GetShortName = sShortName
End Function Sub BreakdownName(sFullName As String, _
ByRef sname As String, _ ByRef sPath As String) Dim nPos As Integer nPos = FileNamePosition(sFullName) If nPos > 0 Then sname = Right(sFullName, Len(sFullName) - nPos) sPath = Left(sFullName, nPos - 1) Else "Invalid sFullName - don"t change anything End If
End Sub Function FileNamePosition(sFullName As String) As Integer
Dim bFound As Boolean Dim nPosition As Integer bFound = False nPosition = Len(sFullName) Do While bFound = False If nPosition = 0 Then Exit Do If Mid(sFullName, nPosition, 1) = "\" Then bFound = True Else " Working right to left nPosition = nPosition - 1 End If Loop If bFound = False Then FileNamePosition = 0 Else FileNamePosition = nPosition End If
End Function
</source>