MyTetra Share
Делитесь знаниями!
Формирование пути к файлу по полному имени файла
25.09.2017
14:53
Раздел: VBA - GetOpen

'#####==============================================================================================

'##### Формирование пути к файлу по полному имени файла

'iParentCatalog - значение для определения материнского коталога


'Sub test_FnStrPathInFullPath()

'ss = "\\rudh002113\share_\PASA_WEB\MonitoringSkidReader\ListPointPJI\12_ListPointUsin_20171107.mdb"

'

'sss = FnStrPathInFullPath(ss, 1)

'End Sub

'------------------------------------------------------------

Function FnStrPathInFullPath(ByVal strFullPath As String, _

Optional iParentCatalog As Integer = 0) As String

Dim m As Variant

Dim strPath As String


If Len(strFullPath) > 0 Then

m = Split(strFullPath, "\", -1, vbTextCompare)

strPath = m(LBound(m))

For i = LBound(m) + 1 To UBound(m) - 1 - iParentCatalog

If Len(m(i)) = 0 Then

strPath = strPath & "\"

Else

strPath = strPath & "\" & m(i)

End If

' Debug.Print strPath

Next i

Erase m

FnStrPathInFullPath = strPath & "\"

Else

FnStrPathInFullPath = ""

End If

End Function

'===================================================================================================


'#####==============================================================================================

'##### Формирование имени к файлу по полному имени файла

'

'------------------------------------------------------------

Function FnStrNameInFullPath(ByVal strFullPath As String) As String

Dim m As Variant


If Len(strFullPath) > 0 Then

m = Split(strFullPath, "\", -1, vbTextCompare)

FnStrNameInFullPath = m(UBound(m))

Erase m

Else

FnStrNameInFullPath = ""

End If

End Function

'===================================================================================================

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