Loop until - Schleife funktioniert nicht

  • Word

Es gibt 3 Antworten in diesem Thema. Der letzte Beitrag () ist von Marcus Gräfe.

    Loop until - Schleife funktioniert nicht

    Hallo Leute,
    ich habe ein Problem mit meinem Code, der Code soll eigentlich bezwecken, dass wenn ich das Fidor Internet Explorer Fenster schließe das andere Fenster automatisch maximiert wird, was leider nicht funktioniert, da Word einfach nicht aus der Schleife rauskommt und sich aufhängt.

    Hier ist mein Code:

    Quellcode

    1. Private Const SM_CXSCREEN As Long = 0
    2. Private Const SM_CYSCREEN As Long = 1
    3. #If VBA7 Then
    4. Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    5. #Else ' VBA6 (für Office Versionen <= 2007)
    6. #End If
    7. Public IEApp, IEDocument As Object
    8. Public Sub IE_Fenster_links_und_rechts()
    9. MonitorBreite = GetSystemMetrics(SM_CXSCREEN)
    10. MonitorHöhe = GetSystemMetrics(SM_CYSCREEN)
    11. Dim Passwort As String
    12. 'Passwort = InputBox("Passwort eingeben:")
    13. Set IEApp = CreateObject("InternetExplorer.Application")
    14. IEApp.Visible = True
    15. IEApp.navigate "https://banking.fidor.de/login"
    16. 'Call wait
    17. IEApp.Application.Width = 960
    18. IEApp.Application.Height = 1050
    19. IEApp.Top = 0
    20. IEApp.Application.Left = 0
    21. Set IEApp2 = CreateObject("InternetExplorer.Application")
    22. IEApp2.Visible = True
    23. IEApp2.navigate "https://farm01.afterbuy.de/afterbuy/auktionsliste.aspx?AWebayname=& _
    24. AWFilter=5&AWSuchwort=&AWRENummer=&AWFilter2=0&awmaxart=100&maxgesamt=500&AWEmail=&AWDatumVon=&AWDatumBis=&AWBezug=EndeDerAuktion&AWPLZ=&AWBetrag=&AWBetragBezug=1&AWStammID=&AWLaenderkennung=&AWLaenderkennungBezug=rechnung&AWLabelDynSearchField1=ShippingAddress&AWDynSearchField1=&AWLabelDynSearchField2=PaymentStatus&AWDynSearchField2=&AWLabelDynSearchField3=PaymentShipMethod&AWDynSearchField3=&killordersession=0&art=SetAuswahl"
    25. IEApp2.Application.Width = 960
    26. IEApp2.Application.Height = 1080
    27. IEBreite = IEApp2.Application.Width
    28. IEHöhe = IEApp2.Application.Height
    29. IEApp2.Top = 0
    30. IEApp2.Application.Left = MonitorBreite - IEBreite
    31. marker = 0
    32. Do
    33. Set objShell = CreateObject("Shell.Application")
    34. IE_count = objShell.Windows.Count
    35. For x = 0 To (IE_count - 1)
    36. On Error Resume Next ' sometimes more web pages are counted than are open
    37. my_url = objShell.Windows(x).Document.Location
    38. my_title = objShell.Windows(x).Document.Title
    39. If my_title Like "Fidor Bank AG - Login" & "*" Then 'compare to find if the desired web _
    40. page is already open
    41. Set ie = objShell.Windows(x)
    42. marker = 1
    43. Exit For
    44. Else
    45. End If
    46. Next
    47. Loop Until marker = 0
    48. If marker = 0 Then
    49. IEApp2.navigate "https://farm01.afterbuy.de/afterbuy/auktionsliste.aspx?AWebayname=& _
    50. AWFilter=37&AWSuchwort=&AWRENummer=&AWFilter2=0&awmaxart=100&maxgesamt=500&AWEmail=&AWDatumVon=&AWDatumBis=&AWBezug=EndeDerAuktion&AWPLZ=&AWBetrag=&AWBetragBezug=1&AWStammID=&AWLaenderkennung=&AWLaenderkennungBezug=rechnung&AWLabelDynSearchField1=ShippingAddress&AWDynSearchField1=&AWLabelDynSearchField2=PaymentStatus&AWDynSearchField2=&AWLabelDynSearchField3=PaymentShipMethod&AWDynSearchField3=&killordersession=0&art=SetAuswahl"
    51. IEApp2.Application.Width = 1920
    52. IEApp2.Application.Height = 1280
    53. IEBreite = IEApp2.Application.Width
    54. IEHöhe = IEApp2.Application.Height
    55. IEApp2.Top = 0
    56. IEApp2.Application.Left = MonitorBreite - IEBreite
    57. Else
    58. End If
    59. End Sub

    2fersen schrieb:

    da Word einfach nicht aus der Schleife rauskommt und sich aufhängt

    Ich vermute, dass es sich um das übliche Problem handelt, dass die Schleife die gesamte CPU-Zeit des Prozesses bekommt und weitere Dinge nicht ausgeführt werden. Da wird dir wohl DoEvents helfen. Oder du schaust mal hier, wie man es schöner macht: fmsinc.com/microsoftaccess/mod…xamples/avoiddoevents.asp (da wird auch DoEvents erklärt).
    Besucht auch mein anderes Forum:
    Das Amateurfilm-Forum