Almó Ster
Almó Ster

Reputation: 11

Use vba to copy everything on already opened IE page

I know how to open a new one and copy everything.

And I also know how to refer to an already opened IE page.

I am struggeling to copy from the already opened internet explorer page

Please help.

Function GetIE() As Object
'return an object for the open Internet Explorer window, or create new one
  For Each GetIE In CreateObject("Shell.Application").Windows() 'Loop to find
    If (Not GetIE Is Nothing) And GetIE.Name = "Internet Explorer" Then Exit For 'Found!
  Next GetIE
  If GetIE Is Nothing Then Set GetIE = CreateObject("InternetExplorer.Application") 'Create
  GetIE.Visible = True 'Make IE window visible

  ' (this is where the code fail) down

        IE.ExecWB 17, 0 '// SelectAll
        IE.ExecWB 12, 2 '// Copy selection
        ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
        Range("A1").Select
        IE.Quit

End Function

Basically I need this code: to work with the already opened IE window and not the URL

Sub Test() 

    Dim IE As Object 

    Sheets("Sheet3").Select 
    Range("A1:A1000") = "" ' erase previous data
    Range("A1").Select 

    Set IE = CreateObject("InternetExplorer.Application") 
        With IE 
            .Visible = True 
            .Navigate "http://www.aarp.org/" ' should work for any URL
            Do Until .ReadyState = 4: DoEvents: Loop 
        End With 

        IE.ExecWB 17, 0 '// SelectAll
        IE.ExecWB 12, 2 '// Copy selection
        ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False 
        Range("A1").Select 
        IE.Quit 

End Sub

Upvotes: 0

Views: 1866

Answers (2)

Deepak-MSFT
Deepak-MSFT

Reputation: 11365

I suggest you try to make a test with the code example below may help you to copy the content of the webpage to the Excel sheet from an already opened IE instance.

VBA code:

Sub demo()

Sheets("Sheet1").Select
Range("A1:A1000") = ""
Range("A1").Select


    Set objShell = CreateObject("Shell.Application")
    IE_count = objShell.Windows.Count
        For x = 0 To (IE_count - 1)
        On Error Resume Next
    
            my_title = objShell.Windows(x).document.Title

            If my_title Like "AARP? Official Site - Join & Explore the Benefits" & "*" Then
                Set IE = objShell.Windows(x)
       
                If Not IE Is Nothing Then
                    IE.ExecWB 17, 0
                    IE.ExecWB 12, 2
                    ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
                    Range("A1").Select
                    'IE.Quit
                End If
            Exit For
            Else
            End If
        Next

End Sub

Output:

enter image description here

Further, you can modify the code example as per your own requirements.

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166885

If you only want to get the one open IE window then you can use GetObject() for that.

If you want to get a specific open window (by URL) then you can do something like this:

Sub tester()
    Dim IE As Object

    Set IE = GetIE("http://www.aarp.org/")
    If Not IE Is Nothing Then
        IE.ExecWB 17, 0 '// SelectAll
        IE.ExecWB 12, 2 '// Copy selection
        ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False 
        Range("A1").Select 
        IE.Quit 
    End If
End sub

Using this:

'get a reference to an existing IE window, given a partial URL
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  'because may not have a "document" property
        'Check the URL and if it's the one you want then
        ' assign the window object to the return value and exit the loop
        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

Upvotes: 2

Related Questions