MyTetra Share
Делитесь знаниями!
Open_Folder2
Время создания: 23.10.2020 14:12
Текстовые метки: Open_Folder
Раздел: !Закладки - VBA - FSO
Запись: adgaver/mytetra_base_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.55
Яндекс индекс цитирования