Copy webpage to excel

pjmsimmons

Board Regular
Joined
Dec 13, 2011
Messages
80
Hi All,
I have some code which is trying to do the following:

I have an excel workbook with a list of the end part of a hyperlink in column A. I want the code for each cell selected to

go to the webpage of the complete hyperlink using the currently instance of IE running
Copy the webpage
Add a worksheet to the workbook (dont require renaming of the worksheet)
copy the page to the new worksheet and repeat until all of the selected cells have had their respective webpage opened and copied (each webpage on a different worksheet).

The code I have nearly works but i am getting an error 438 object doesn't support this property or method at the 'Activeworksheet.select' line

Does anyone have any ideas to help me out?

regards,

Paul

Code:
Public Sub Test()
    Dim objWindow As Object
    Dim objIEApp As Object
    Dim objShell As Object
    Dim objItem As Object
    Dim y As Range
    Dim IE As Object
    Dim pageText As String
    Dim page As Variant
    
    
    For Each y In Selection
    
    On Error GoTo Fin
    Set objShell = CreateObject("Shell.Application")
    Set objWindow = objShell.Windows()
    For Each objItem In objWindow
        If LCase(objItem.FullName Like "*iexplore*") Then
            Set objIEApp = objItem
        End If
    Next objItem
    If objIEApp Is Nothing Then
        Set objIEApp = CreateObject("InternetExplorer.Application")
        objIEApp.Visible = True
    End If
    With objIEApp
        .Visible = True
        .Navigate "[URL="http://www.icbf.com/taurus/ahi_lab/ahi_lab_search.php?action=search&tag=&herd"]http://www.[/URL]google.com" & y
        While Not .ReadyState = 4
            DoEvents
        Wend
        .Document.all.q.Value = strTMP
        .Document.Forms(0).submit
    End With
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
    Set objWindow = Nothing
    Set objShell = Nothing
    
        Worksheets.Add
        Activeworksheet.Select
     pageText = objIEApp.Document.body.innertext
    page = Split(pageText, vbCr)
    Range("A1").Resize(UBound(page)).Value = Application.Transpose(page)
        
    Next y
    
End Sub
 

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,619
The code I have nearly works but i am getting an error 438 object doesn't support this property or method at the 'Activeworksheet.select' line
Try ActiveSheet.Select instead, or delete that line because the newly added worksheet is by default the active sheet.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,837
Messages
5,598,378
Members
414,234
Latest member
grlevesq

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top