MyTetra Share
Делитесь знаниями!
Open_Folder
02.05.2019
16:17
Текстовые метки: Open_Folder
Раздел: !Закладки - VBA - FSO

'Option Explicit

Private Declare Function SetForegroundWindow Lib "User32.dll" (ByVal hWnd As Long) As Long

Private Declare Function ShowWindow Lib "User32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Public Sub Test()

' http://www.cyberforum.ru/vba/thread2037683.html

Const SW_RESTORE As Long = 9

Dim bFound As Boolean

Dim sFolder As String

Dim sURL As String

sFolder = "C:\Users\" '"G:\Games"

sFolder = "C:\Users\qwert\AppData\Local\Programs\"

sURL = "file:///" & Replace(sFolder, "\", "/")

With CreateObject("Shell.Application")

Dim iWin As Object

For Each iWin In .Windows

If StrComp(iWin.LocationURL, sURL, 1) = 0 Then

SetForegroundWindow iWin.hWnd

ShowWindow iWin.hWnd, SW_RESTORE

bFound = True

End If

Next

If Not bFound Then .Open CStr(sFolder) 'byval (!)

End With

End Sub

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


Private Sub Test_Win()

' http://www.cyberforum.ru/vba/thread2037683.html

strFolder = "Sql Server" '"C:\Users\"

With CreateObject("Shell.Application")

Dim iWin As Object

For Each iWin In .Windows

Debug.Print iWin.LocationName, iWin.Document.Folder.Self.Path 'iWin.LocationURL

' If iWin.LocationName = strFolder Then

' 'If iWin.LocationURL = "file:///C:/Имя%20папки" Then

' .Open iWin.LocationURL: Exit For

' End If

Next

End With

End Sub

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



Sub test1()

' http://qaru.site/questions/6791053/check-if-a-folder-is-open-vba

Dim OpenFold As Variant

Dim oShell As Object

Dim Wnd As Object

Dim strFolder


' OpenFold = "mysubfolder"

' strFolder = "U:\myfolder\" & OpenFold

' strFolder = "C:\Users\"

Set oShell = CreateObject("Shell.Application")


For Each Wnd In oShell.Windows

If Wnd.Name = "Проводник" Then ' : Name : "Проводник" "Windows Explorer": String

If Wnd.Document.Folder.Self.Path = strFolder Then Exit Sub

End If

Next Wnd

Application.ThisWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True

End Sub

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



Sub OpenFld()

strFolder = "C:\Users\"

'Shell "explorer.exe " & strAttachMain, vbMaximizedFocus 'открыть папку


'+ : objShellApp : : Variant/Object/IShellDispatch6

Set objShellApp = CreateObject("Shell.Application")

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

Set objShellApp = Nothing

End Sub

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

'открываем папку

'Call Fn_Open_Folder(strAttachPPT)

Sub Fn_Open_Folder(ByVal strFolder As String)

Set objShellApp = CreateObject("Shell.Application")

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

Set objShellApp = Nothing

End Sub









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