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

Материал из VB Эксперт
Версия от 12:47, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

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