VBA/Excel/Access/Word/File Path/File Name
Версия от 16:33, 26 мая 2010; (обсуждение)
Get file name
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
Get short file name
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