Cannot access with the html object model the content of the internet page when opened in a new window after a click RRS feed

  • Question

  • Dear all,

    Can someone please help me with the last difficulty in my code

    I am managing an IE.document using the html object module. When I click programmatically on a button , a new window in IE appears. Setting the IE.document second time it sets it to parent page, not the new window. How can i access the new window with an html object. The final window cannot be accessed directly.

    Here is the sample of working code.

    After the  htmlDoc.getElementsByClassName("btnStatus floatLeft").Item(0).Click

    the new internet page opens on a new window without tabs.

    The command Set htmlDoc = IE.document does set the document to the original page not the new window.

    How can I control that please.

    Thank you 

    Option Explicit

    Function NKK_Survey_button() As String
    On Error GoTo Err_NKK_Survey_button
    Dim NKK_Status_Link As String

    Dim IE As SHDocVw.InternetExplorer
    Dim htmlDoc As MSHTML.HTMLDocument
    Dim htmltargetref As MSHTML.HTMLLinkElement
    Dim wrkbkhtml As Excel.Workbook
    Dim sheethtml As Excel.Worksheet
    Dim rangehtml As Excel.Range

    Set IE = New SHDocVw.InternetExplorer
    'You can comment next line when it is working
        IE.Visible = True
        ' Send the form data To URL As POST binary request
        IE.navigate ""
        ' Statusbar
        Application.StatusBar = "NKK Site is loading. Please wait..."
        ' Wait while IE loading...
        Do While IE.Busy
            Application.Wait DateAdd("s", 10, Now)
        Application.StatusBar = "Search form submission. Please wait..."
    Set htmlDoc = IE.document
     IE.Visible = False
     htmlDoc.getElementsByClassName("btnStatus floatLeft").Item(0).Click
        ' Wait while IE re-loading...
        Do While IE.Busy
            Application.Wait DateAdd("s", 2, Now)
        ' Show IE
        Application.Wait DateAdd("s", 10, Now)
        IE.Visible = True
     Set htmlDoc = Nothing
        Application.StatusBar = ""
     'the new status page
     Set htmlDoc = IE.document
     Dim i, j As Integer
     Dim htmltabTR As Object
     Dim htmltabCell As Object
     Set htmltabTR = htmlDoc.getElementsByTagName("TR")
     If htmltabTR Is Nothing Then GoTo SecondSearch
     j = 0
     While j < htmltabTR.Length - 1
        Set htmltabCell = Nothing
        Set htmltabCell = htmltabTR.Item(j)
        If Not htmltabCell Is Nothing Then
         If htmltabCell.all.Length > 0 Then
            For i = 0 To htmltabCell.Cells.Length - 1
                If InStr(1, htmltabCell.Cells.Item(i).innerText, "Docking") > 0 Then
                    NKK_Survey_button = htmltabCell.Cells.Item(i + 1).innerText
                End If
         End If
        End If
     j = j + 1
     '   NKK_Status_Link = htmlDoc.URL
     'The open in excel does notwork
      '  Workbooks.Open (htmlDoc.URL)
      'htmlDoc.execCommand ("Download to Excel")
      'Workbooks.OpenXML (htmlDoc.URL)

    'Set sheethtml = ActiveWorkbook.Worksheets(1)

    'Set sheethtml = wrkbkhtml.Worksheets(1)

    'Set rangehtml = sheethtml.Cells.Find("Drydocking Survey")
    '1 êïëþíá äåîéÜ åßíáé ç çìåñïìçíßá
    'NKK_Survey_button = sheethtml.Cells(rangehtml.Row, rangehtml.Column + 1)


        Exit Function

        MsgBox Err.Description
        Resume Exit_NKK_Survey_button

    End Function

    Sunday, November 3, 2013 8:41 PM