MyTetra Share
Делитесь знаниями!
File Name
16.03.2019
23:43
Раздел: !Закладки - VBA - VBA / Excel / Access / Word - File Path

'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

 
Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования