Copy pate from website into excel

[emoandy05]

Hello!

This should be pretty simply. Was hoping for a macro that will go to a website, copy all the data (as if I were to ctrl+a), and paste that into excel.

Any assistance would be greatly appreciated.

Thank you!

 

[John_w]

Search for "InternetExplorer ExecWb", for example the code here which you will need to modify for your purposes.

 

[emoandy05]

So the code that you linked looks for a specific tab once the page is loaded, and then copies that data. I just wanted to load the page and copy the data there, all of it.

Would that be much different?

Public Sub IE_Copy_Page()
    Dim IE As InternetExplorer
    Dim URL As String
    Dim HTMLdoc As HTMLDocument
    Dim link As HTMLAnchorElement
    Dim tabDiv As HTMLDivElement
    Dim i As Long
    Dim destSheet As Worksheet, shp As Shape
    
    Set destSheet = Worksheets(1)
    With destSheet
        .Cells.Clear
        For Each shp In .Shapes
            shp.Delete
        Next
    End With
    
    URL = "[URL]https://www.google.com/[/URL]"
    
    Set IE = New InternetExplorer
    With IE
        .Visible = True
        .navigate URL
        While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
        Set HTMLdoc = .document
    End With
    
    Set link = Nothing
    i = 0
    While i < HTMLdoc.Links.Length And link Is Nothing
        If InStr(HTMLdoc.Links(i).innerText, "Technical analysis") > 0 Then Set link = HTMLdoc.Links(i)
        i = i + 1
    Wend
    If Not link Is Nothing Then
        link.Click
    Else
        MsgBox "'Technical analysis' link not found"
        Exit Sub
    End If
       
    Set tabDiv = HTMLdoc.getElementById("tabs7")
    While InStr(tabDiv.innerText, "Trend") = 0
        DoEvents
    Wend
    
    With IE
        While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
        .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
        .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DONTPROMPTUSER
        .ExecWB OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DODEFAULT
    End With
    
    With destSheet
        .Activate
        .Range("A1").Select
        .Paste
        .Range("A1").Select
    End With
       
End Sub

 

[John_w]

Here is the code without the bits you don't need. You must set a reference to Microsoft Internet Controls via Tools->References in the VBA editor.

Public Sub IE_Copy_Page()
    Dim IE As InternetExplorer
    Dim URL As String
    Dim destSheet As Worksheet
    
    Set destSheet = ActiveSheet
    
    URL = "[URL="https://www.mrexcel.com/forum/redirect-to/?redirect=https%3A%2F%2Fwww.google.com%2F"]https://www.google.com/[/URL]"
    
    Set IE = New InternetExplorer
    With IE
        .Visible = True
        .navigate URL
        While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend

        .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
        .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DONTPROMPTUSER
        .ExecWB OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DODEFAULT
    End With
    
    With destSheet
        .Activate
        .Range("A1").Select
        .Paste
        .Range("A1").Select
    End With
       
End Sub

 

[emoandy05]

Thanks Jon,

I do receive the following error:

"Automation error, Trying to revoke a drop target that has not been registered"

Any thoughts?

 

[John_w]

Which line causes that error? To find out, click the Debug button on the error message window and the errant line is highlighted in yellow.

Try adding a delay between the Select All and Copy lines:

        Application.Wait DateAdd("s", 1, Now)

 

[ashishkubansal]

@John_w
Sorry to bother you. I need a little help with my code. my code runs into the same error.
"Automation error, Trying to revoke a drop target that has not been registered" as soon as it processes any of following commands

.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DONTPROMPTUSER
.ExecWB OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DODEFAULT

full text of code. I need to copy all text and paste it in excel in background. (so I can't use sendkeys)

Public Sub IE_Copy_Page()
Dim IE As InternetExplorer
Dim URL As String
Dim destSheet As Worksheet

Set destSheet = ActiveSheet

URL = "https://s3-ap-southeast-1.amazonaws.../2096d3d487f9c5a9dc9f24941b81c6f547b1e984.pdf"


Set IE = New InternetExplorer
With IE
.Visible = True
.navigate URL
While .Busy And .readyState <> READYSTATE_COMPLETE: DoEvents: Wend


Application.Wait (Now + TimeSerial(0, 0, 4))



.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DONTPROMPTUSER
.ExecWB OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DODEFAULT
End With

With destSheet
.Activate
.Range("A1").Select
.Paste
.Range("A1").Select
End With

End Sub

screenshot of error

 

[John_w]

@John_w
Sorry to bother you. I need a little help with my code. my code runs into the same error.
"Automation error, Trying to revoke a drop target that has not been registered" as soon as it processes any of following commands

.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DONTPROMPTUSER
.ExecWB OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DODEFAULT

Try adding .RegisterAsDropTarget = True before the .Visible line. However, I doubt that will fix the error because the IE document is a PDF file and I don't think ExecWB works with a PDF file embedded in a web page.

 

[ashishkubansal]

No solution with that. Anything else you can suggest? Send message or anything at all?

 

[John_w]

Try this macro. It uses the UIAutomationClient library to extract text from a PDF web page like yours. The text is put in column A of the active sheet.

You must set the references noted at the top of the code, using Tools -> References in the VBA editor, otherwise the code won't compile or run.

'References required:
'Microsoft Internet Controls
'UIAutomationClient

Option Explicit

Public Sub IE_Get_PDF_Text()

    Dim IE As InternetExplorer
    Dim URL As String
    Dim destCell As Range
    Dim PDFtext As String, PDFlines As Variant
    
    With ActiveWorkbook.ActiveSheet
        .Columns("A").Clear
        Set destCell = .Range("A1")
    End With
    
    URL = "https://s3-ap-southeast-1.amazonaws.com/meesho-supply-v2/invoices/supplierToReseller/2096d3d487f9c5a9dc9f24941b81c6f547b1e984.pdf"
    
    'Get existing amazonaws.com IE window.  If not found get any IE window.  If none found open new IE window
    
    Set IE = Get_IE_Window2("amazonaws.com")
    If IE Is Nothing Then
        Set IE = Get_IE_Window2("")
        If IE Is Nothing Then Set IE = New InternetExplorer
    End If
    
    With IE
        .Visible = True
        .navigate URL
        While .Busy And .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
        PDFtext = UIAutomation_Get_IE_PDF_Text(.hwnd)
    End With
    
    PDFlines = Split(PDFtext, vbCrLf)
    destCell.Resize(UBound(PDFlines) + 1).Value = Application.Transpose(PDFlines)
    
End Sub


'Extract text of all edit controls in a PDF document in an IE web page

#If VBA7 Then
Private Function UIAutomation_Get_IE_PDF_Text(IEhwnd As LongPtr) As String
#Else
Private Function UIAutomation_Get_IE_PDF_Text(IEhwnd As Long) As String
#End If
   
    Dim UIauto As IUIAutomation
    Dim IEwindow As IUIAutomationElement, IEdoc As IUIAutomationElement
    Dim DocCondition As IUIAutomationCondition
    Dim EditControlCondition As IUIAutomationCondition
    Dim EditControls As IUIAutomationElementArray
    Dim EditControl As IUIAutomationElement
    Dim i As Long
    Dim text As String

    UIAutomation_Get_IE_PDF_Text = ""
    
    'Create UIAutomation object
    
    Set UIauto = New CUIAutomation
            
    'Get Internet Explorer UIAutomation element
    
    Set IEwindow = UIauto.ElementFromHandle(ByVal IEhwnd)
    IEwindow.SetFocus   'optional - brings the IE window to the foreground
    
    'Find the IE document
    'ControlType:           UIA_DocumentControlTypeId (0xC36E)
    'LocalizedControlType:  "document"
    'ClassName:             "AVL_AVView"
    
    Set DocCondition = UIauto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_DocumentControlTypeId)
    Do
        Set IEdoc = IEwindow.FindFirst(TreeScope_Descendants, DocCondition)
        DoEvents
    Loop While IEdoc Is Nothing
                
    'Find all edit controls in the document and concatenate their values to the function return string
    
    Set EditControlCondition = UIauto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_EditControlTypeId)
    Set EditControls = IEdoc.FindAll(TreeScope_Descendants, EditControlCondition)
    
    For i = 0 To EditControls.Length - 1
        Set EditControl = EditControls.GetElement(i)
        text = EditControl.GetCurrentPropertyValue(UIA_ValueValuePropertyId)
        UIAutomation_Get_IE_PDF_Text = UIAutomation_Get_IE_PDF_Text & text & vbCrLf
    Next
    
End Function