VBA code om een bepaald Internet Explorer venster te sluiten gevraagd

Status
Niet open voor verdere reacties.

Dagobert

Gebruiker
Lid geworden
25 mrt 2005
Berichten
13
Ik ben op zoek naar een code of script in VBA waarbij ik vanuit Outlook een Internet Explorer venster kan sluiten.

Wie kan mij hiermee helpen :thumb:
 
Hai, :D

Kun je wat specifieker zijn?

Een Inet explorer venster??

Is dit altijd hetzelfde venster? Zo ja welke Titel heeft deze Exact?

Is het gewoon een draaiende instantie van de Explorer...

Waarom moet deze dicht? Open je hem ook zelf met code..

Iets meer info aub...:thumb:
 
Ik openen hem zelf, ik krijg een mailtje, hier staan links in, deze worden automatisch geopend en deze wil ik dan ook weer sluiten.
Voor dit sluiten wil ik dan ook een code hebben.
Het ne mailtje heeft 1 link en een ander mailtje heeft er meer dit is vaiabel.
Dit is de code die ik gebruik:

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As String) As Long
Private Const GWL_STYLE = -16
Private Const WS_DISABLED = &H8000000
Private Const WM_CANCELMODE = &H1F
Private Const WM_CLOSE = &H10

Sub ReadBodyForHyperlink(Item As Outlook.MailItem)
Dim r As Long
'Dim lngResult As Long
'Dim lnghWND As Long
Dim strWWWAdres As String
Dim strBody As String
'Dim intCounter As Integer

strBody = Item.Body
strWWWAdres = ""
e = 0
y = 0
b = 0
b = InStr(1, Item.Body) 'starts within the body of the page
Do While e < Len(Item.Body) 'stopt als het einde van mail bericht is bereikt
a = InStr(b + 1, Item.Body, "HYPERLINK " & Chr(34)) 'Zoek naar tekst welke begint met Hyperlink"
If a = 0 Then Exit Sub 'Als geen tekst is gevonden dan stoppen
b = InStr(a + 11, Item.Body, Chr(34))
c = Mid(Item.Body, a + 11, b)
d = InStr(1, c, Chr(34)) 'Zoeken naar het einde van de tekst, zoeken naar de afsluiting met "
f = Mid(Item.Body, a + 11, d - 1) 'Pak de tekst tussen " en "
e = b
'strWWWAdres = ""
'strWWWAdres = f + Chr(10) + strWWWAdres 'Chr(10) = Enter
g = Right(f, 3)
g1 = Right(f, 11)
h = Left(f, 6)
'Zorgen dat niet iedere link wordt geopend.
If g = "gif" Or g = "bmp" Or g1 = "members.php" Or g1 = "fmelden" Or h = "mailto" Then
f = ""
Else
'Openen van de gevonden link(s)
r = ShellExecute(0, "Open", "C:\PROGRA~1\INTERN~1\IEXPLORE.EXE", f, 0, 1)
' intCounter = 1
' Test Timer
' Do Until intCounter = 10000000
' MsgBox prompt:=intCounter, Title:="VBPJ"
' intCounter = intCounter + 1
' Loop
End If
' lngResult = SendMessage(r, &H10, 0&, 0&)
y = y + 1
' MsgBox y
Loop
End Sub

Hopelijk dat u weet hoe ik de geopende vensters kan openen.
 
Laatst bewerkt:
Hai, :D

Uhmms zit jij nu 3 keer dezelfde sub in één berichtje te kopieren??? :p

Lekker overzichtelijk..Zou je aub je voorgaande bericht iets willen opkuisen zodat ik wat met jou code kan?

Volgende vraag wanneer moet het venster gesloten worden? Na x tijd of wat anders?

Hoe wordt de sub ReadBodyForHyperlink geactiveerd? (Door: Private Sub Application_NewMail())?

Of voer je hem handmatig uit.

Vertel..:thumb:
 
Sorry hoor maar nu heb je een stuk van de Sub weggeknipt en is er geen End Sub meer?

En mijn andere vragen?
 
Sorry ik had idd in eerste instantie 3x geplakt en daarna te veel weg geknipt, heb het ontbrekende stuk erbij geplakt.

De titel weet ik niet, en de vensters worden allemaal in een afzonderlijk ie scherm geopend.

De mail wordt geopend door de code (deze opent de gevonden links in de mail body) en deze geopende vensters dienen hierna ook weer te worden gesloten door de code.
De titels zijn bij mij onbekend is er een manier om deze te achterhalen, of de links om de beurt te openen en sluiten.

Hopelijke weten jullie me te helpen. :thumb:
 
Laatst bewerkt:
Hai, :D

Ik moet helaas nog wat meer weten want ik wil mijn oplossing graag eerst testen voor ik hem geef..

Ik begrijp nog steeds niet wanneer het moment is dat jij het venster dmv code gesloten wilt laten worden?

Jou code loopt door alle hyperlinks en opent deze in een internet venster...(Leuk als je 100 links hebt) ;)

Maar goed ik snap dus niet wanneer zo'n venster gesloten moet worden...(ook snap ik het doel van de code niet maar goed dat hoeft ook niet)

Ook vroeg ik om de aanroepprocedure van Subprocedure ReadBodyForHyperlink geactiveerd?

Deze wilt namelijk een mailitem als voorwaarde hebben en kan dus niet uitzichzelf gestart worden maar moet opgeroepen worden...dus hoe ziet de aanroepende code eruit? (Loop je door alle mails?)

Volgens mij moet je iets van een tellertje ertussen hebben welke het venster gewoon 10 seconden openhoud en daarna het venster weer sluit...

Dus aangezien ik het nog niet snap nogmaals info? :thumb:
 
De sub wordt aangeroepen door middel van de bericht regels in MS Outlook, bij binnenkomen uitvoeren van dit script.

Inderdaad moet er nog een timer tussen komen, en misschien dat ie link voor link afwerkt, dus hij vindt een link opent hem en na een x aantal seconden moet hij deze weer sluiten, hierna pakt ie de volgende link en zo door en door tot de laatste link.
 
Hoop dat het je lukt, ik heb er (nog) niet zoveel kaas van gegeten dat me dit lukte.

Alvast heel erg bedankt en ik zie het met hoop tegenmoet.

:thumb: :) :thumb:
 
Ik heb een stukje code erin waardoor ie ff pauzeert en waardoor ie een proces nr toekent, ik weet niet of dit goed is, maar voor alsnog werkt het, als ik nu een code heb waardoor hij dat venster sluit dan is het rond dan hoef ik alleen de tijd te verlengen.
Niet gek voor een dag klooien vond ik zelf, ben namelijk niet dus danig los op dit soort vb werk.

De code is als volgt:

Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = -1&

'Openen van de gevonden link(s)
' r = ShellExecute(0, "Open", "C:\PROGRA~1\INTERN~1\IEXPLORE.EXE", f, 0, 1)

program_name = "C:\PROGRA~1\INTERN~1\IEXPLORE.EXE " & f
' Start the program.
On Error GoTo ShellError
process_id = Shell(program_name, vbNormalFocus)
' On Error GoTo 0

' Wait for the program to finish.
' Get the process handle.
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
If process_handle <> 0 Then
WaitForSingleObject process_handle, 3000
CloseHandle process_handle
End If

Hopelijk dat iemand weet hoe je zo'n zogenaamd proces moet beeindigen waardoor het venster sluit.

:thumb: :D :thumb:
 
Hai, :D

Was gisteren hiep hiep ****a...dus vandaar mijn late reactie! ;)

Je hebt nogal een voorliefde voor API's vindt ik ...das wel mooi hoor maar deze heb je maar zelden nodig binnen VBA..

Dus heb voor de gelegenheid alle API's maar eens overbodig gemaakt..

Zie aangepaste code:
Code:
Sub ReadBodyForHyperlink(Item As Outlook.MailItem)
Dim r As Long
Dim e As Integer, b As Integer, a As Integer, c As String
Dim d As Integer, f As String, g As String, g1 As String, h As String
Dim StartTime   As Single

e = 0
b = 0
b = InStr(1, Item.Body)
    Do While e < Len(Item.Body)
        a = InStr(b + 1, Item.Body, "HYPERLINK " & Chr(34))
        If a = 0 Then Exit Sub
            b = InStr(a + 11, Item.Body, Chr(34))
            c = Mid(Item.Body, a + 11, b)
            d = InStr(1, c, Chr(34))
            f = Mid(Item.Body, a + 11, d - 1)
            e = b
            g = Right(f, 3)
            g1 = Right(f, 11)
            h = Left(f, 6)
        If g = "gif" Or g = "bmp" Or g1 = "members.php" Or g1 = "fmelden" Or h = "mailto" Then
            f = ""
        Else
            OpenIEWaitAndClose (f)
        End If
    Loop
End Sub

Sub OpenIEWaitAndClose(sURL As String)
Dim IE          As Object
Dim StartTime   As Single

 Set IE = CreateObject("InternetExplorer.Application")
 
 With IE
    .Visible = True
    .Navigate sURL
    
    Do Until Not .Busy
        DoEvents
    Loop
    
    StartTime = Timer
    
    Do While Timer < StartTime + 10 '10 seconden
        DoEvents
    Loop
    
    .Quit
 End With
 Set IE = Nothing
End Sub
Nu wordt iedere hyperlink geopend voor 10 seconden en daarna gesloten en het volgende linkje geopend..

Veel plezier ermee! :thumb:
 
He!!! :D
Nog gefeliciteerd met je verjaardag.

Normaal kan ik nie achter het i.net door de weeks, maar zit nu toevallig ff bij een vriendin en kon het niet laten om ff te kijken, kon bijna een gat in de lucht springen, maar: :(

Heb de code over gecopieerd naar Outlook maar hij doet niet als ik de code laat uitvoeren.

Als ik na set ie, ie. intype krijg ik ook geen keuze menu is dat normaal?
Moet ik nog een verwijzing activeren of iets.

Waar kan dit aan liggen?

:thumb:
 
Laatst bewerkt:
Hai, :D

Dank je!

Dat het niet werkt is echt vreemd!

Heb je jou eigen sub wel eerst veranderd in Commentaar?

Kies in het menu Foutopsporing eens Compileren? Krijg je foutmeldingen?

Inderdaad na IE geen intellisense na de punt. dit is een Object dus de VBE heeft geen idee welke eigenschappen en methoden hij moet laten zien..(Kwestie van weten)

Om te testen:
Maak van alle Modules in de VBE commentaar!
Plak mijn code in een module en compileer de code op foutmeldingen...geen fout dan de boel opslaan en Outlook herstarten. (Ja bij vraag om te saven)

In Outlook de wizard regels controleren of hij inderdaad nog naar het juiste script verwijst...

Dit zou probleemloos moeten draaien kan niet verklaren waarom dit bij jou niet werkt....

Succes! :thumb:
 
Ik heb ff snel gekeken in de help van Outlook en daar staat het volgende:

Deze methode is bedoeld om andere toepassingen te automatiseren vanuit Microsoft Visual Basic Scripting Edition (VBScript) 1.0, waarin geen methode CreateObject is opgenomen. CreateObject is opgenomen in VBScript versie 2.0 en hoger. Deze methode mag niet worden gebruikt om Microsoft Outlook te automatiseren vanuit VBScript.Deze methode is bedoeld om andere toepassingen te automatiseren vanuit Microsoft Visual Basic Scripting Edition (VBScript) 1.0, waarin geen methode CreateObject is opgenomen. CreateObject is opgenomen in VBScript versie 2.0 en hoger. Deze methode mag niet worden gebruikt om Microsoft Outlook te automatiseren vanuit VBScript.

Volgens mij laat outlook niet toe dat je IE op deze manier aanroept.

Kan dat kloppen :confused:
 
Hai, :D

Nee dat klopt niet. Zoals gezegd werkt dit bij mij perfect.

Ik werk al jaren met CreateObject en ken daar geen problemen mee...

Heb je mijn adviezen reeds uitgeprobeerd?
Welke versie van Outlook heb je?

Greets...:thumb:
 
O ja er staat overigens dat het niet mag vanuit VBSCRIPT!

Deze scriptingtaal heeft zeker overeenkomsten met VB en VBA maar is zeker niet hetzelfde...;)
 
Nog wat:

* Ben je dit thuis aan het testen of bij jou vriendin?
* Als dat zo is staan de macrobeveiligingen wel op Gemiddeld?

Je zegt dat het niet werkt..wat werkt er niet doet ie helemaal niets?
Krijg je een foutmelding? Zo ja exact welke...

Snap er echt noppes van dat ding draait hier als een zonnetje...:)
 
Nu werkt ie idd toppie :thumb: :D :thumb:

Alleen krijg ik in het begin de melding dat een programma toegang probeert te krijgen tot mijn email adressen, kan ik dit ergens uitzetten of instellen, heb namelijk de beveiliging al op minimaal staan.

Echt tof dit, zou je me die createobject ie gegevens wat na de punt staan kunnen doorsturen of een site of zo waar ze opstaan.

Toppie :thumb: :thumb: :thumb:
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan