Minimiertes Explorer Fenster anzeigen

Sub explorer_anzeigen() Dim objShell As Object, win As Object Dim strFullPath As String, gefunden As Boolean strFullPath = "Beispielpfad\vorlagen" 'Pfad anpassen gefunden = False If Dir(strFullPath, vbDirectory) > "" Then Set objShell = CreateObject("Shell.Application") For Each win In objShell.Windows If InStr(1, UCase(win.FullName), "EXPLORER") > 0 Then If LCase(win.Document.Folder.self.Path) = LCase(strFullPath) Then AppActivate win.locationname win.Activate gefunden = True Exit For End If End If Next If gefunden = False Then objShell.explore (strFullPath) Set objShell = Nothing Else MsgBox "Pfad nicht vorhanden!", vbCritical End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
teste mal:

Option Explicit
Private Declare PtrSafe Function EnumWindows Lib "user32.dll" ( _
    ByVal lpEnumFunc As LongPtr, _
    ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetWindowTextA Lib "user32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowTextLengthA Lib "user32.dll" ( _
    ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetClassNameA Lib "user32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function GetWindowLongPtrA Lib "user32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByRef lpdwProcessId As Long) As Long
Private Declare PtrSafe Function AllowSetForegroundWindow Lib "user32.dll" ( _
    ByVal dwProcessId As Long) As Long
Private Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" ( _
    ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByVal nCmdShow As Long) As Long
Private Const SW_SHOWNORMAL As Long = 1
Private Const GWL_STYLE As Long = -16
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_BORDER As Long = &H800000
Private Const GC_CLASSNAME_EXPLORER As String = "CabinetWClass"
Private Const FOLDER_PATH As String = "H:\230125" 'Pfad anpassen
Private lblnFound As Boolean
Private llngprtHwnd As LongPtr
Public Sub explorer_anzeigen()
    Dim objShell As Object
    Dim lngProcessID As Long
    If Dir$(FOLDER_PATH, vbDirectory) > vbNullString Then
        lblnFound = False
        Call EnumWindows(AddressOf WindowCallBack, ByVal 0)
        If lblnFound Then
            lngProcessID = GetWindowThreadProcessId(llngprtHwnd, ByVal 0&)
            Call AllowSetForegroundWindow(lngProcessID)
            Call SetForegroundWindow(llngprtHwnd)
            Call ShowWindow(llngprtHwnd, SW_SHOWNORMAL)
        Else
            Set objShell = CreateObject("Shell.Application")
            Call objShell.Explore(FOLDER_PATH)
            Set objShell = Nothing
        End If
    Else
        MsgBox "Pfad nicht vorhanden!", vbCritical
    End If
End Sub
Private Function WindowCallBack(ByVal lngptrHwnd As LongPtr, ByVal lngptrParam As LongPtr) As LongPtr
    Dim strCaption As String, strClassName As String
    Dim lngReturn As Long, lngptrStyle As LongPtr
    lngptrStyle = GetWindowLongPtrA(lngptrHwnd, GWL_STYLE)
    If lngptrStyle And (WS_VISIBLE Or WS_BORDER) = WS_VISIBLE Or WS_BORDER Then
        strClassName = Space$(256)
        lngReturn = GetClassNameA(lngptrHwnd, strClassName, 256)
        strClassName = Left$(strClassName, lngReturn)
        If strClassName = GC_CLASSNAME_EXPLORER Then
            lngReturn = GetWindowTextLengthA(lngptrHwnd)
            strCaption = Space$(lngReturn)
            Call GetWindowTextA(lngptrHwnd, strCaption, lngReturn + 1)
            If strCaption = FOLDER_PATH Then
                llngprtHwnd = lngptrHwnd
                lblnFound = True
                Exit Function
            End If
        End If
    End If
    WindowCallBack = 1
End Function

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Minimiertes Explorer Fenster anzeigen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

34 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Minimiertes Explorer Fenster anzeigen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

34 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread