Copy webpage to excel

[pjmsimmons]

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

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

 

[John_w]

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.