Welke windowsschermen staan nu op via Shell.Windows

[Sander32]

Wie oh wie kan mij helpen met shell.windows in vba
Ik ben bezig om diverse websites op content te controleren echter blijk sommige websites een inlogscherm te hebben waardoor de code vastloopt.
Zodra je deze website opent, wordt er een inlogscherm geopent en wacht mijn code op een antwoord.
Wanneer ik handmatig deze inlogscherm sluit, dan loopt mijn applicatie weer.
Ik heb in ieder geval ontdekt dat je shell.windows object dit kan beinvloeden echter werkt het nog niet.
Wellicht kan iemand mij vertellen welke windows op het moment open zijn en dat ik vanuit daar een keuze kan maken welke te sluiten.
Mijn huidige code betreft:

Dim Shell As Object
Dim IE As Object
    
    On Error GoTo ErrorGen
    
    Set Shell = CreateObject("Shell.Application")
    For Each IE In Shell.Windows
        Debug.Print TypeName(IE.Document)
        If TypeName(IE.Document) = "HTMLDocument" Or TypeName(IE.Document) = "IShellFolderViewDual2" Then
            IE.Quit
        End If
    Next
        
ErrorGen:
If Err.Number > 0 Then
    Err.Clear
End If

Ik verwacht wanneer ik weet welke windowsschermen op het moment open zijn, ik deze dus kan sluiten.
Op een of ander manier ziet ie de IE inlogscherm niet als een IE object.
Het zou dus heel goed kunnen dat het dus geen IE scherm is maar een ander type windowsscherm vandaar dat ik graag wil weten hoe ik de openstaande schermen kan opvragen via VBA.

 

[Sander32]

Opgelost:
Code overnemen en waar nodig aanpassen!
Hiermee kan je windowschermen op naam selecteren, uitschakelen en zelfs activeren
Succes
'declaratie van een dll om logginnaam te filteren
D

eclare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
  (ByVal hwnd As Long, ByVal lpString As String, _
  ByVal aint As Long) As Long
Declare Function GetWindow Lib "user32" _
  (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function EnumWindows Lib "user32" _
  (ByVal wndenmprc As Long, ByVal lParam As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  lParam As Any) As Long

Private Const WM_CLOSE = &H10
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Private Const GW_OWNER = 4
Private Const GW_CHILD = 5
Private Const GW_MAX = 5

Private mstrTarget As String
Private mblnSuccess As Boolean
Public strCloseWindowname As String

Private Type UserRec
   bMach(1 To 32) As Byte  ' 1st 32 bytes hold machine name
   bUser(1 To 32) As Byte  ' 2nd 32 bytes hold user name
End Type


Public Function blnFindWindow(strApplicationTitle As String) As Boolean

   Dim hWndTmp As Long
   Dim nRet As Integer
   Dim TitleTmp As String
   Dim TitlePart As String
   Dim MyWholeTitle As String
   Dim mCounter As Long
   Dim hWndOver As Integer
   Dim sClassName As String * 100

   blnFindWindow = False

   TitlePart = UCase$(strApplicationTitle)

   'loop through all the open windows
   hWndTmp = FindWindow(0&, 0&)

   Do Until hWndTmp = 0

      TitleTmp = Space$(256)
      nRet = GetWindowText(hWndTmp, TitleTmp, Len(TitleTmp))
        Debug.Print TitleTmp
      'If nRet Then
      'wanneer windownaam 
      If InStr(TitleTmp, "VERBINDING") > 0 And InStr(TitleTmp, " MAKEN") > 0 Then
         'retrieve window title
         TitleTmp = UCase$(Left(TitleTmp, nRet))
         'compare window title & "VERBINDING"
         If InStr(TitleTmp, TitlePart) Then
            
            strCloseWindowname = TitleTmp
            blnFindWindow = True
            Exit Do
         End If
      End If

      hWndTmp = GetWindow(hWndTmp, GW_HWNDNEXT)
      mCounter = mCounter + 1

   Loop

   End Function


Public Function blnCloseWindow(strApplicationTitle As String) As Boolean

   ' retrieve Windows list of tasks.
   mblnSuccess = False
   mstrTarget = strApplicationTitle
   EnumWindows AddressOf EnumCallback, 0
   blnCloseWindow = mblnSuccess

End Function


Public Function EnumCallback(ByVal app_hWnd As Long, _
  ByVal param As Long) As Long

   Dim buf As String * 256
   Dim title As String
   Dim length As Long

   ' Checks a returned task to determine if App should be closed

   ' get window's title.
   length = GetWindowText(app_hWnd, buf, Len(buf))
   title = Left$(buf, length)

   ' determine if target window.
   If InStr(UCase(title), UCase(mstrTarget)) <> 0 Then
      ' Kill window.
      SendMessage app_hWnd, WM_CLOSE, 0, 0
      mblnSuccess = True
   End If

   ' continue searching.
   EnumCallback = 1

End Function

' The usage of these function is straight forward and fall into 2 parts: determining if a specific application is open and if necessary closing that application. The 2 function all are as follows:

'   If blnFindWindow("Notepad") Then
'       If Not blnCloseWindow("Notepad") Then
'           MsgBox "Problems encountered closing Window", _
'             vbInformation, "API Call"
'           Exit Sub
'       End If
'   End If

 

[huijb]

Code dient tussen codetags geplaatst te worden zodat het overzichtelijk blijft voor de helpers.

 

[Sander32]

Okay, dit wist ik niet.
Had wel de advies van de vriendelijke helpende senioren hier meegekregen wanneer ik een oplossing heb zelf deze te plaatsen en dat had ik gedaan.
Ik hoop dat ik anderen een plezier heb kunnen doen, voor nu of in de toekomst!