navigating to an unnamed spawned window ?


T

tmp2100

I have the following VBA code to launch an IE application, navigate to a URL,
and submit a form.
The page which pops-up does not have a directly addressable URL, but is
generated
and directly filled-in by java when the form is submitted. What is the VBA
statement needed in the
following code to get a handle to the unnamed spawned page so that objects on
the page can be
referenced ?

Sub Clt_Data_Fetch()
Dim ie As Object

' launch IE and navigate to URL
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://thisistheURL/index.html"

' wait for login page to come up
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState <> 1: Loop

' fill in login form and submit
ie.document.all.Item("name").Value = "loginstring"
ie.document.all.Item("passwd").Value = "passwordstring"
ie.document.all.Item("submit").Click

' wait for spawned page to come up
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState <> 1: Loop
Application.Wait (Now() + TimeValue("0:00:07"))

' close login page, leaving spawned page visible
ie.Quit

' *********** what is statement needed here to make reference to a 'table'
object with
' ID = "abcTab" in the unnamed spawned page ******************

endSub
 
Ad

Advertisements

T

Tim Williams

If you know the URL of the spawned window (look at the source for the form you're submitting)
then you can use the function below.
It will return the document object for the first window it finds with an address "like" the passed URL.
It a window is not found it will return nothing.

dim oDoc, oTable

set oDoc=GetHTMLDocument("htt p://thisistheURL/responsedir/")
if not oDoc is nothing then

set oTable=oDoc.getElementById("abcTab")

end if



Tim

'#################################################
'Find an IE window with matching location and get the document from
' the loaded page. Assumes no frames.
Function GetHTMLDocument(sAddress As String) As Object

Dim objShell As Object, objShellWindows As Object, o As Object
Dim retVal As Object, sURL As String


Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows

'see if IE is already open
For Each o In objShellWindows
sURL = ""
On Error Resume Next
sURL = o.document.Location
On Error GoTo 0
If sURL <> "" Then
If sURL Like sAddress & "*" Then
Set retVal = o
Exit For
End If
End If
Next o

Set GetHTMLDocument = retVal
End Function
 
T

tmp2100 via OfficeKB.com

Tim:
This appears to work. If I monitor the value of oDoc, the
correct URL does show up. However, when the
set oTable=oDoc.getElementById("abcTab")
statement executes, a VB runtime error #438 occurs:
"object doesnt support this property or method"

Any suggestions on what's wrong?


Tim said:
If you know the URL of the spawned window (look at the source for the form you're submitting)
then you can use the function below.
It will return the document object for the first window it finds with an address "like" the passed URL.
It a window is not found it will return nothing.

dim oDoc, oTable

set oDoc=GetHTMLDocument("htt p://thisistheURL/responsedir/")
if not oDoc is nothing then

set oTable=oDoc.getElementById("abcTab")

end if

Tim

'#################################################
'Find an IE window with matching location and get the document from
' the loaded page. Assumes no frames.
Function GetHTMLDocument(sAddress As String) As Object

Dim objShell As Object, objShellWindows As Object, o As Object
Dim retVal As Object, sURL As String

Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows

'see if IE is already open
For Each o In objShellWindows
sURL = ""
On Error Resume Next
sURL = o.document.Location
On Error GoTo 0
If sURL <> "" Then
If sURL Like sAddress & "*" Then
Set retVal = o
Exit For
End If
End If
Next o

Set GetHTMLDocument = retVal
End Function
I have the following VBA code to launch an IE application, navigate to a URL,
and submit a form.
[quoted text clipped - 36 lines]
 
T

Tim Williams

Sorry, my mistake in the function.

Set retVal = o

should be:

Set retVal = o.document

Tim

--
Tim Williams
Palo Alto, CA


tmp2100 via OfficeKB.com said:
Tim:
This appears to work. If I monitor the value of oDoc, the
correct URL does show up. However, when the
set oTable=oDoc.getElementById("abcTab")
statement executes, a VB runtime error #438 occurs:
"object doesnt support this property or method"

Any suggestions on what's wrong?


Tim said:
If you know the URL of the spawned window (look at the source for the form you're submitting)
then you can use the function below.
It will return the document object for the first window it finds with an address "like" the passed URL.
It a window is not found it will return nothing.

dim oDoc, oTable

set oDoc=GetHTMLDocument("htt p://thisistheURL/responsedir/")
if not oDoc is nothing then

set oTable=oDoc.getElementById("abcTab")

end if

Tim

'#################################################
'Find an IE window with matching location and get the document from
' the loaded page. Assumes no frames.
Function GetHTMLDocument(sAddress As String) As Object

Dim objShell As Object, objShellWindows As Object, o As Object
Dim retVal As Object, sURL As String

Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows

'see if IE is already open
For Each o In objShellWindows
sURL = ""
On Error Resume Next
sURL = o.document.Location
On Error GoTo 0
If sURL <> "" Then
If sURL Like sAddress & "*" Then
Set retVal = o
Exit For
End If
End If
Next o

Set GetHTMLDocument = retVal
End Function
I have the following VBA code to launch an IE application, navigate to a URL,
and submit a form.
[quoted text clipped - 36 lines]
 
T

tmp2100 via OfficeKB.com

Tim:
I also found that changing the statement:
set oTable=oDoc.getElementById("abcTab")
to:
set oTable=oDoc.document.getElementById("abcTab")
also works as an alternative to your fix.

Now that oTable is set to the correct element, what statement(s) are needed
to cause the contents of oTable to be pasted back to the Excel spreadsheet
from which this macro is being run ?



==================================================================
Tim said:
Sorry, my mistake in the function.

Set retVal = o

should be:

Set retVal = o.document

Tim
Tim:
This appears to work. If I monitor the value of oDoc, the
[quoted text clipped - 55 lines]
 
T

Tim Williams

The document object model doesn't psermit a copy/paste operation, but you can access the individual rows/cells and get the content
from selected ones...

Eg:

Msgbox oTable.rows(2).cells(2).innerHTML

Tim

--
Tim Williams
Palo Alto, CA


tmp2100 via OfficeKB.com said:
Tim:
I also found that changing the statement:
set oTable=oDoc.getElementById("abcTab")
to:
set oTable=oDoc.document.getElementById("abcTab")
also works as an alternative to your fix.

Now that oTable is set to the correct element, what statement(s) are needed
to cause the contents of oTable to be pasted back to the Excel spreadsheet
from which this macro is being run ?



==================================================================
Tim said:
Sorry, my mistake in the function.

Set retVal = o

should be:

Set retVal = o.document

Tim
Tim:
This appears to work. If I monitor the value of oDoc, the
[quoted text clipped - 55 lines]

--
tmp2100

Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.aspx/excel-programming/200604/1
 
Ad

Advertisements

T

tmp2100 via OfficeKB.com

Tim:
I presume that to pull in a big table, all I need is to do is, for example,
size the rows and cells counts large enough to match or exceed the size
of the target table ? for example,
Msgbox oTable.rows(10000).cells(100000).innerHTML

In your example, what is the subsequent statement needed to pull the complete
Msgbox
content into the spreadsheet from which the macro is being run ?

===============================================================================
Tim said:
The document object model doesn't psermit a copy/paste operation, but you can access the individual rows/cells and get the content
from selected ones...

Eg:

Msgbox oTable.rows(2).cells(2).innerHTML

Tim
Tim:
I also found that changing the statement:
[quoted text clipped - 23 lines]
 
T

Tim Williams

rows(x) and cells(y) are indexes, not counts.

Rows have cells, so your example only pulls the content from the 100000th cell on the 10000th row.

Is your table really this large ?

You could try reading in the entire table using oTable.innerText and see what you get. Otherwise iterate through all the cells
copying each value in turn.

--
Tim Williams
Palo Alto, CA


tmp2100 via OfficeKB.com said:
Tim:
I presume that to pull in a big table, all I need is to do is, for example,
size the rows and cells counts large enough to match or exceed the size
of the target table ? for example,
Msgbox oTable.rows(10000).cells(100000).innerHTML

In your example, what is the subsequent statement needed to pull the complete
Msgbox
content into the spreadsheet from which the macro is being run ?

===============================================================================
Tim said:
The document object model doesn't psermit a copy/paste operation, but you can access the individual rows/cells and get the content
from selected ones...

Eg:

Msgbox oTable.rows(2).cells(2).innerHTML

Tim
Tim:
I also found that changing the statement:
[quoted text clipped - 23 lines]
 
T

Tim Williams

Try this:

*********************************************************
Sub Tester()
Dim o, t
Set o = GetIE("http://someserver/somepage.html")
If Not o Is Nothing Then
Set t = o.document.getElementsByTagName("table")(0)
CopyTableToRange t, ThisWorkbook.Sheets("Sheet1").Range("A1")
Else
MsgBox "Page not found!"
End If
End Sub

Sub CopyTableToRange(tTable, rRange As Range)
Dim r, c
Dim iCol As Integer, lRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error GoTo haveError

lRow = 0
For Each r In tTable.Rows
iCol = 0
For Each c In r.Cells
rRange.Cells(1).Offset(lRow, iCol).Value = c.innerText
iCol = iCol + 1
Next c
lRow = lRow + 1
Next r

haveError:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Function GetIE(sLocation As String) As Object

Dim objShell As Object, objShellWindows As Object, o As Object
Dim sURL As String
Dim retVal As Object

Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows

For Each o In objShellWindows
sURL = ""
On Error Resume Next
'check the URL and if it's the one you want then
' assign it to the return value
sURL = o.document.Location
On Error GoTo 0
If sURL Like sLocation & "*" Then
Set retVal = o
Exit For
End If
Next o

Set GetIE = retVal

End Function
'*****************************************************


--
Tim Williams
Palo Alto, CA


Tim Williams said:
rows(x) and cells(y) are indexes, not counts.

Rows have cells, so your example only pulls the content from the 100000th cell on the 10000th row.

Is your table really this large ?

You could try reading in the entire table using oTable.innerText and see what you get. Otherwise iterate through all the cells
copying each value in turn.

--
Tim Williams
Palo Alto, CA


tmp2100 via OfficeKB.com said:
Tim:
I presume that to pull in a big table, all I need is to do is, for example,
size the rows and cells counts large enough to match or exceed the size
of the target table ? for example,
Msgbox oTable.rows(10000).cells(100000).innerHTML

In your example, what is the subsequent statement needed to pull the complete
Msgbox
content into the spreadsheet from which the macro is being run ?

===============================================================================
Tim said:
The document object model doesn't psermit a copy/paste operation, but you can access the individual rows/cells and get the content
from selected ones...

Eg:

Msgbox oTable.rows(2).cells(2).innerHTML

Tim

Tim:
I also found that changing the statement:
[quoted text clipped - 23 lines]

endSub
 
T

tmp2100 via OfficeKB.com

Tim:
Your solution works --- thanks.

In my application, the target table has 14 columns and typically 8500 rows
(the row count varies daily).
The application runs slowly due to the cell-by-cell copying, requiring just
over 8 minutes to
complete. Is there a faster alternative, such as using some other form of
"innerTable" referencing
or by somehow using "queryTable"? If so, please provide code examples.

The complete working excel application is listed below.
There may be some extraneous statements remaining in the code from debugging.
Fixed time delays seem to be necessary, or otherwise the application doesnt
always work.

Thanks again

'-----------------------------------------------------------------------------
--------------------------------------------------------------
' Opens a specific webpage which does not have a directly addressable URL,
' captures table data located on the page, and copies it into a spreadsheet.
'-----------------------------------------------------------------------------
--------------------------------------------------------------
Sub Nas_CLT_Data_Fetch()
Dim ie As Object
Dim ieDoc As Object
Dim starttime As String
Dim endtime As String
Dim oDoc As Object
Dim oTable As Object

Windows("PERSONAL.XLS").Activate
starttime = Range("A5").Value
endtime = Range("A6").Value

Workbooks.Open Filename:= _
"C:\Documents and Settings\theRealUser\My Documents\REPORT_GEN.XLS"
Sheets("CLT").Select
Range("A13").Select

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://theRealUrl/nas/index.html"

Application.Wait (Now() + TimeValue("0:00:02"))
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: Loop
Application.Wait (Now() + TimeValue("0:00:05"))

ie.document.all.Item("name").Value = "theRealUserName"
ie.document.all.Item("passwd").Value = "theRealPassword"
ie.document.all.Item("submit").Click

Application.Wait (Now() + TimeValue("0:00:02"))
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: Loop
Application.Wait (Now() + TimeValue("0:00:10"))

ie.document.all.Item("cstep").Click
ie.document.all.Item("tspan").selectedIndex = 8
ie.document.getElementById("customSpan2").Style.visibility = "visible"
ie.document.all.Item("stime").Value = starttime
ie.document.all.Item("etime").Value = endtime
ie.document.all.Item("request").Value = "Summary Table"
ie.document.all.Item("nasForm").submit

Application.Wait (Now() + TimeValue("0:00:02"))
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: Loop
Application.Wait (Now() + TimeValue("0:00:10"))

ie.Quit
Set ie = Nothing

Set oDoc = GetHTMLDocument("http://theRealUrl:
8080/nas/servlet/FetchResult")
If Not oDoc Is Nothing Then
Set oTable = oDoc.document.getElementById("nasTab")
CopyTableToRange oTable, Workbooks("REPORT_GEN.XLS").Sheets("CLT").
Range("A13")
End If

oDoc.Quit
Set oDoc = Nothing
End Sub


Sub CopyTableToRange(tTable, rRange As Range)
Dim r, c
Dim iCol As Integer, IRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error GoTo haveError

IRow = 0
For Each r In tTable.Rows
iCol = 0
For Each c In r.Cells
rRange.Cells(1).Offset(IRow, iCol).Value = c.innerText
iCol = iCol + 1
Next c
IRow = IRow + 1
Next r

haveError:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Function GetHTMLDocument(sAddress As String) As Object

Dim objShell As Object, objShellWindows As Object, o As Object
Dim retVal As Object, sURL As String

Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows

For Each o In objShellWindows
sURL = ""
On Error Resume Next
sURL = o.document.Location
On Error GoTo 0
If sURL <> "" Then
If sURL Like sAddress & "*" Then
Set retVal = o
Exit For
End If
End If
Next o
Set GetHTMLDocument = retVal
End Function


========================================================================
Tim said:
Try this:

*********************************************************
Sub Tester()
Dim o, t
Set o = GetIE("http://someserver/somepage.html")
If Not o Is Nothing Then
Set t = o.document.getElementsByTagName("table")(0)
CopyTableToRange t, ThisWorkbook.Sheets("Sheet1").Range("A1")
Else
MsgBox "Page not found!"
End If
End Sub

Sub CopyTableToRange(tTable, rRange As Range)
Dim r, c
Dim iCol As Integer, lRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error GoTo haveError

lRow = 0
For Each r In tTable.Rows
iCol = 0
For Each c In r.Cells
rRange.Cells(1).Offset(lRow, iCol).Value = c.innerText
iCol = iCol + 1
Next c
lRow = lRow + 1
Next r

haveError:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Function GetIE(sLocation As String) As Object

Dim objShell As Object, objShellWindows As Object, o As Object
Dim sURL As String
Dim retVal As Object

Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows

For Each o In objShellWindows
sURL = ""
On Error Resume Next
'check the URL and if it's the one you want then
' assign it to the return value
sURL = o.document.Location
On Error GoTo 0
If sURL Like sLocation & "*" Then
Set retVal = o
Exit For
End If
Next o

Set GetIE = retVal

End Function
'*****************************************************
rows(x) and cells(y) are indexes, not counts.
[quoted text clipped - 31 lines]
 
Ad

Advertisements

T

Tim Williams

Don't have time to test this, but you could try taking the whole document.outerHTML string and saving it to a file (with .html
extension), then opening that file in Excel. You should then be able to read the table as a block from there.

Tim


tmp2100 via OfficeKB.com said:
Tim:
Your solution works --- thanks.

In my application, the target table has 14 columns and typically 8500 rows
(the row count varies daily).
The application runs slowly due to the cell-by-cell copying, requiring just
over 8 minutes to
complete. Is there a faster alternative, such as using some other form of
"innerTable" referencing
or by somehow using "queryTable"? If so, please provide code examples.

The complete working excel application is listed below.
There may be some extraneous statements remaining in the code from debugging.
Fixed time delays seem to be necessary, or otherwise the application doesnt
always work.

Thanks again

'-----------------------------------------------------------------------------
--------------------------------------------------------------
' Opens a specific webpage which does not have a directly addressable URL,
' captures table data located on the page, and copies it into a spreadsheet.
'-----------------------------------------------------------------------------
--------------------------------------------------------------
Sub Nas_CLT_Data_Fetch()
Dim ie As Object
Dim ieDoc As Object
Dim starttime As String
Dim endtime As String
Dim oDoc As Object
Dim oTable As Object

Windows("PERSONAL.XLS").Activate
starttime = Range("A5").Value
endtime = Range("A6").Value

Workbooks.Open Filename:= _
"C:\Documents and Settings\theRealUser\My Documents\REPORT_GEN.XLS"
Sheets("CLT").Select
Range("A13").Select

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://theRealUrl/nas/index.html"

Application.Wait (Now() + TimeValue("0:00:02"))
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: Loop
Application.Wait (Now() + TimeValue("0:00:05"))

ie.document.all.Item("name").Value = "theRealUserName"
ie.document.all.Item("passwd").Value = "theRealPassword"
ie.document.all.Item("submit").Click

Application.Wait (Now() + TimeValue("0:00:02"))
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: Loop
Application.Wait (Now() + TimeValue("0:00:10"))

ie.document.all.Item("cstep").Click
ie.document.all.Item("tspan").selectedIndex = 8
ie.document.getElementById("customSpan2").Style.visibility = "visible"
ie.document.all.Item("stime").Value = starttime
ie.document.all.Item("etime").Value = endtime
ie.document.all.Item("request").Value = "Summary Table"
ie.document.all.Item("nasForm").submit

Application.Wait (Now() + TimeValue("0:00:02"))
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: Loop
Application.Wait (Now() + TimeValue("0:00:10"))

ie.Quit
Set ie = Nothing

Set oDoc = GetHTMLDocument("http://theRealUrl:
8080/nas/servlet/FetchResult")
If Not oDoc Is Nothing Then
Set oTable = oDoc.document.getElementById("nasTab")
CopyTableToRange oTable, Workbooks("REPORT_GEN.XLS").Sheets("CLT").
Range("A13")
End If

oDoc.Quit
Set oDoc = Nothing
End Sub


Sub CopyTableToRange(tTable, rRange As Range)
Dim r, c
Dim iCol As Integer, IRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error GoTo haveError

IRow = 0
For Each r In tTable.Rows
iCol = 0
For Each c In r.Cells
rRange.Cells(1).Offset(IRow, iCol).Value = c.innerText
iCol = iCol + 1
Next c
IRow = IRow + 1
Next r

haveError:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Function GetHTMLDocument(sAddress As String) As Object

Dim objShell As Object, objShellWindows As Object, o As Object
Dim retVal As Object, sURL As String

Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows

For Each o In objShellWindows
sURL = ""
On Error Resume Next
sURL = o.document.Location
On Error GoTo 0
If sURL <> "" Then
If sURL Like sAddress & "*" Then
Set retVal = o
Exit For
End If
End If
Next o
Set GetHTMLDocument = retVal
End Function


========================================================================
Tim said:
Try this:

*********************************************************
Sub Tester()
Dim o, t
Set o = GetIE("http://someserver/somepage.html")
If Not o Is Nothing Then
Set t = o.document.getElementsByTagName("table")(0)
CopyTableToRange t, ThisWorkbook.Sheets("Sheet1").Range("A1")
Else
MsgBox "Page not found!"
End If
End Sub

Sub CopyTableToRange(tTable, rRange As Range)
Dim r, c
Dim iCol As Integer, lRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error GoTo haveError

lRow = 0
For Each r In tTable.Rows
iCol = 0
For Each c In r.Cells
rRange.Cells(1).Offset(lRow, iCol).Value = c.innerText
iCol = iCol + 1
Next c
lRow = lRow + 1
Next r

haveError:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Function GetIE(sLocation As String) As Object

Dim objShell As Object, objShellWindows As Object, o As Object
Dim sURL As String
Dim retVal As Object

Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows

For Each o In objShellWindows
sURL = ""
On Error Resume Next
'check the URL and if it's the one you want then
' assign it to the return value
sURL = o.document.Location
On Error GoTo 0
If sURL Like sLocation & "*" Then
Set retVal = o
Exit For
End If
Next o

Set GetIE = retVal

End Function
'*****************************************************
rows(x) and cells(y) are indexes, not counts.
[quoted text clipped - 31 lines]

--
tmp2100

Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.aspx/excel-programming/200605/1
 
Ad

Advertisements


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top