VBA/Excel/Access/Word/File Path/File Name

Материал из VB Эксперт
Перейти к: навигация, поиск

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>