PDA

View Full Version : Internet Explorer VBA Automation - Help with one issue needed



mitko007
08-06-2015, 11:33 AM
Hi guys,

i wrote a code the lets me automate a procedure which a have to do on a daily basis.

BAsically the procedure does the following:
1. Opens a website and logs in
2. Get several hyperlinks for the website
3. Navigate to all obtained hyperlinks, performs some configurations and then downloads some data. During this process several new IE windows open and the data is obtained on the last one.

If i use only 1 hyperlink it works fine. However, i need to loop the procedures for all hyperlinks. The problem i have is that when i close the child window with a IE.quit statement my parent IE window doesn't work anymore (it loses the connection to my code)

I am posting the code with the explanations and the problem at the end. I really hope that someone can help me with this.

Thanks in advance



Public Declare PtrSafe Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As LongPtr)

Sub DownloadData()
' open IE, navigate to the desired page and loop until fully loaded
Dim ie As Object
Dim Shell As Object
Dim Text As String

Dim elem As Object
Dim j As Variant


Set ie = CreateObject("InternetExplorer.Application")
my_url = "https://........................"


With ie
.Visible = True
.navigate my_url

Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop

End With

With ie
'-------------------------------
' Input the userid and password
'-------------------------------
ie.document.getElementById("user").Value = Worksheets("Setup").Range("B6")
ie.document.getElementById("pass").Value = Worksheets("Setup").Range("B7")

Call Sleep(1000)
' Click the "Login" button and loop until fully loaded
ie.document.getElementById("Login").Click

Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop
End With

Call Sleep(4000)

' Get selected hypelinks and write to the sheet

Set AllHyperlinks = ie.document.getElementsByTagName("A")

i = 2
For Each hyper_link In AllHyperlinks
If hyper_link.innerText = Worksheets("Setup").Range("A10") Then
Worksheets("Hidden").Range("E" & i) = hyper_link
i = i + 1
End If
Next

m = 25
GetLinksRowCount = Worksheets("Hidden").Range("E1048576").End(xlUp).Row

'------------------------------------------------------
'LOOP PROCEDURE BELOW FOR ALL PREVIOUSLY OBTAINED HYPERLINKS
'-------------------------------------------------------

For k = 2 To GetLinksRowCount

'NAvigate to the first obtained hyperlinks

well_URL = Worksheets("Hidden").Range("E" & k)

With ie
.Visible = True
.navigate well_URL

Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop

End With

'---------------------------------------------------------------
'...
'...
'perfom certain operations on the website and click a button
' after wich a SECOND !! IE opens
'---------------------------------------------------------------

' Find and use the new window by searching trough the titles

Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
On Error Resume Next ' sometimes more web pages are counted than are open
my_url = objShell.Windows(x).document.Location
my_title = objShell.Windows(x).document.Title

If my_title Like "xxxxxxxxx" Then
Set ie = objShell.Windows(x)
Exit For
Else
End If
Next

'--------------------------------
' CLICK button on the SECOND window which opens a THIRD IE Window (SECOND closes automatically)
'--------------------------------

' Find and use the THIRD window by searching trough the URLs

Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
On Error Resume Next ' sometimes more web pages are counted than are open
my_url = objShell.Windows(x).document.Location
my_title = objShell.Windows(x).document.Title

If Left(my_url, 54) Like "https://www..................." Then
Set ie = objShell.Windows(x)
Exit For
Else
End If
Next

Call Sleep(3000)

'--------------------------------
' CLICK button on the THIRD window - 4th IE Window opens (3rd closes automatically)
'--------------------------------

Call Sleep(3000)

' Find and use the FOURTH window by searching trough the URLs
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
On Error Resume Next ' sometimes more web pages are counted than are open
my_url = objShell.Windows(x).document.Location
my_title = objShell.Windows(x).document.Title

If Left(my_url, 52) Like "https://www........." Then
Set ie = objShell.Windows(x)
Exit For
Else
End If
Next

Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop

'------------------------------------
'GET TEXT FROM THE NEW (Fourth) WINDOW
'-------------------------------------

Text = ie.document.body.innerHTML

'----------------------------------------
' Write Text to *.txt file and save using a CreateFile function
'-----------------------------------------
CreateFile Worksheets("Setup").Range("A22") & "\" & Worksheets("Setup").Range("A" & m - 1) & "_" & Worksheets("Hidden").Range("H1") & ".txt", Text

Call Sleep(1000)
ie.Quit
' closing the SECOND currenty opened IE windows and keep only the first one active

Next k

'Repeat procedure for next Hyperlink --> Here is where i get troubles since when i try to navigate to the
'next hyperlink IE doesn't follow the navigate command. It seems like the Quit statement terminates the
'connection between my code and Internet Explorer

End Sub

mitko007
08-10-2015, 02:01 AM
BUMP