Třída pro zjištění disku, cesty, jména a přípony souboru

Postup:
V projektu založte novou třídu.

Do této třídy vložte následující kód:
Option Explicit

Private msFullPath As String
Private msPath As String
Private msDrive As String
Private msFile As String
Private msExt As String

Public Property Get FullPath() As String
    FullPath = msFullPath
End Property

Public Property Let FullPath(sNewFullPath As String)

    Dim iPos As Integer
    Dim iCounter As Integer

    msFullPath = sNewFullPath
    msDrive = ""
    msPath = ""
    msFile = ""
    msExt = ""

   'Zjištění disku
    iPos = InStr(1, msFullPath, ":")
    If iPos > 0 Then  'Drive exists
        msDrive = Left$(msFullPath, iPos)
    End If

    If Right$(msFullPath, 1) = "/" Or _
Right$(msFullPath, 1) = "\" Or _
InStr(1, msFullPath, ".") = 0 Then

      'Na cestě není specifikován soubor
        msFile = ""
        msExt = ""
        msPath = msFullPath

       'Připojit backslash pokud tam nejsou
        If Right$(msPath, 1) <> "/" And _
Right$(msPath, 1) <> "\" Then
            msPath = msPath & "\"
        End If

    Else

        iPos = Len(msFullPath)
       'Cyklus po msFullPath dokud nezjistíme celé jméno
        For iCounter = iPos To 1 Step -1
            If Mid$(msFullPath, iCounter, 1) = "/" _
            Or Mid$(msFullPath, iCounter, 1) = "\" Then
                'není více znaků
                Exit For
            Else
                msFile = Mid$(msFullPath, _
                iCounter, 1) & msFile
            End If
        Next

       'Zjištění cesty bez jména souboru
        msPath = Left$(msFullPath, _
                 Len(msFullPath) - Len(msFile))

       'Zjištění přípony
        iPos = InStr(1, msFile, ".")
        msExt = Right$(msFile, Len(msFile) - iPos)

    End If

End Property

Public Property Get Path() As String
    Path = msPath
End Property

Public Property Get Drive() As String
    Drive = msDrive
End Property

Public Property Get File() As String
    File = msFile
End Property

Public Property Get Extension() As String
    Extension = msExt
End Property

Nyní, při volání třídy, zadejte cestu do FullPath a pak už si jenom zjistěte hodnoty pro Drive, Path, File a Extension.

Zpět

Autor: The Bozena