Microsoft Excel

Herbers Excel/VBA-Archiv

Shell.AppActivate und SendKey

Betrifft: Shell.AppActivate und SendKey von: Mike
Geschrieben am: 26.10.2020 20:05:37

Hallo zusammen,

ich komme irgendwie nicht weiter. Das nachfolgende Makro soll ein geöffnetes Windows Explorer Fenster aktivieren und über den SendKeys Befehl schließen.
Ich erhalte aber immer ein Fehler beim Kompilieren. Das Argument ist nicht Optional.
Aber nach allem was ich gelesen habe sollte es klappen. Kann mir da jemand weiter helfen?

Sub b()
  Dim success As Object
  Dim win As Object
 
 success = Shell.AppActivate("\\blabla.com\bla\blub\temp\xyz\Zeug")
        If success Then Shell.SendKeys "%{F4}"
  Set objShell = Nothing

End Sub
Danke und Gruß
Mike

Betrifft: AW: Shell.AppActivate und SendKey
von: ralf_b
Geschrieben am: 26.10.2020 20:23:11

bei mir geht das so.

AppActivate Shell("C:\Program Files\Mozilla Firefox\firefox.exe")

Betrifft: pardon ich sehe grad basiskenntnisse ...
von: ralf_b
Geschrieben am: 26.10.2020 20:24:27

https://docs.microsoft.com/de-de/office/vba/language/reference/user-interface-help/appactivate-statement#example

Betrifft: AW: Shell.AppActivate und SendKey
von: Mike
Geschrieben am: 26.10.2020 20:39:53

Hallo Ralf,

soweit ich das sehe bezieht sich dein Vorschlag aber auf das schließen der kompletten Applikation und würde alle Fenster schließen.

Ich möchte aber gezielt über den fenstertitel ein Windows Explorer fenster ansprechen und auch nur dieses schließen. Andere Explorer Fenster sollen weiterhin geöffnet bleiben.

Gruß
Mike

Betrifft: AW: Shell.AppActivate und SendKey
von: Nepumuk
Geschrieben am: 26.10.2020 21:22:53

Hallo Mike,

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 PostMessageA Lib "user32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByVal wMsg As Long, _
    ByVal wParam As LongPtr, _
    ByVal lParam As LongPtr) As Long
#If Win64 Then
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongPtrA" ( _
    ByVal hwnd As LongPtr, _
    ByVal nIndex As Long) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
    ByVal hwnd As LongPtr, _
    ByVal nIndex As Long) As LongPtr
#End If

Private Const GC_CLASSNAMEEXPLORER As String = "CabinetWClass"
Private Const GWL_STYLE As Long = -16&
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_BORDER As Long = &H800000
Private Const MAX_CLASS_NAME As Long = 255
Private Const WM_CLOSE As Long = &H10

Private lstrCaption As String

Public Sub Start()
    lstrCaption = "G:\Eigene Dateien\Eigene Excelbeispiele" ' Anpassen !!!
    Call EnumWindows(AddressOf WindowCallBack, ByVal 0)
End Sub

Private Function WindowCallBack(ByVal pvlngptrHwnd As LongPtr, ByVal lngptrParam As LongPtr) As Long
    Dim strCaption As String, strClassName As String
    Dim lngReturn As Long
    Dim lngptrStyle As LongPtr
    lngptrStyle = GetWindowLong(pvlngptrHwnd, GWL_STYLE)
    If (lngptrStyle And (WS_VISIBLE Or WS_BORDER)) = (WS_VISIBLE Or WS_BORDER) Then
        strClassName = Space$(MAX_CLASS_NAME)
        lngReturn = GetClassNameA(pvlngptrHwnd, strClassName, MAX_CLASS_NAME)
        strClassName = Left$(strClassName, lngReturn)
        If strClassName = GC_CLASSNAMEEXPLORER Then
            lngReturn = GetWindowTextLengthA(pvlngptrHwnd)
            strCaption = Space$(lngReturn)
            Call GetWindowTextA(pvlngptrHwnd, strCaption, lngReturn + 1)
            If strCaption = lstrCaption Then
                Call PostMessageA(pvlngptrHwnd, WM_CLOSE, 0&, 0&)
                WindowCallBack = 0
            End If
        End If
    End If
    WindowCallBack = 1
End Function

Gruß
Nepumuk

Betrifft: AW: Shell.AppActivate und SendKey
von: Mike
Geschrieben am: 26.10.2020 21:43:22

Hallo Nepumuk,

keine Ahnung wie oft du mir bereits geholfen hast aber auch diesmal passt deine Lösung hervorragend.
Endlich kann ich einen Haken dahinter machen.

Besten Dank

Gruß
Mike