MyTetra Share
Делитесь знаниями!
Open_Folder2
Время создания: 23.10.2020 14:12
Текстовые метки: Open_Folder
Раздел: Разные закладки - VBA - FSO
Запись: xintrea/mytetra_db_adgaver_new/master/base/1603451558x9d62w2iza/text.html на raw.githubusercontent.com

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

'открываем папку "загрузки"

'

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

Sub Open_Folder()

'    Dim strPath As String

'    Dim strUserName As String

'        '"D:\LocalData\au11101\Downloads\"

''        strUserName = w_Name_User_Comp.FnUserName

'        strUserName = VBA.Environ("UserName")

'        strPath = "D:\LocalData\" & strUserName & "\Downloads\"

'        Shell "explorer.exe " & strPath, vbMaximizedFocus

strPath = ActiveCell.Value

 

    If InStr(1, strPath, "\", vbTextCompare) Then

        strPath = fun_StrPathInFullPath(strPath, "\")

        Set objShellApp = CreateObject("Shell.Application")

        Call objShellApp.Explore(strPath)  'открыть папку

        Set objShellApp = Nothing

        Exit Sub

    End If

    If InStr(1, strPath, "/", vbTextCompare) Then

        strPath = fun_StrPathInFullPath(strPath, "/")

'        Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

        ActiveWorkbook.FollowHyperlink strPath

        Exit Sub

    End If

End Sub

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

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

'

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

Function fun_StrPathInFullPath(ByVal strFullPath As String, _

                                Optional ByVal strDelim As String = "\") As String

Dim m As Variant

Dim strPath As String

 

    If Len(strFullPath) > 0 Then

        m = Split(strFullPath, strDelim, -1, vbTextCompare)

 

        strPath = m(LBound(m))

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

            If Len(m(i)) = 0 Then

                strPath = strPath & strDelim

            Else

                strPath = strPath & strDelim & m(i)

            End If

    '        Debug.Print strPath

        Next i

        Erase m

        fun_StrPathInFullPath = strPath & strDelim

    Else

        fun_StrPathInFullPath = ""

    End If

End Function

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

 

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