Get data from web page and paste to excel

[flaviu123]

Hello! Please help me with VBA code to copy the web page in Excel, using the source code. Thanks in advance!




Sub ExtractWeb()


'to refer to the running copy of Internet Explorer
Dim ie As InternetExplorer
'open Internet Explorer in memory, and go to website
Set ie = New InternetExplorer
ie.Visible = True
ie.Navigate "http://www.bet365.com/extra/ro/results-and-archive/results/?Fromdate=2%2f6%2f2015+12%3a38&SearchPath=fixture&FixtureId=0&Period=1&ChallengeId=0&Teamid=&CompetitionId=20120651&SportId=146&SportDesc=Fotbal%2bvirtual&Todate=3%2f6%2f2015+12%3a38&LanguageId=23&Zoneid=22"


'Wait until IE is done loading page
Do While ie.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop


'show text of HTML document returned
Set html = ie.Document
ie.Document.PutInClipboard


Worksheets("Sheet4").Range("A1").Select
'Range("A1").Value = html.DocumentElement.outerHTML
ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
DisplayAsIcon:=False
End Sub

 

[Leith Ross]

Hello flaviu1223,

Here is a faster way to return the page source. A problem I saw with your code is cell "A1" will not display all of the text from the web page. This macro breaks the code up into lines and pastes a line per row. This makes the format much easier to read.

<code>Sub ExtractWeb()
    
    Dim PageSrc As String
    Dim Text    As Variant
    Dim Url     As String
    
        Url = "http://www.bet365.com/extra/ro/results-and-archive/results/?Fromdate=2%2f6%2f2015+12%3a38&SearchPath=fixture&FixtureId=0&Period=1&ChallengeId=0&Teamid=&CompetitionId=20120651&SportId=146&SportDesc=Fotbal%2bvirtual&Todate=3%2f6%2f2015+12%3a38&LanguageId=23&Zoneid=22"
        
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", Url, False
            .Send
            
            While .readyState <> 4: DoEvents: Wend
            
            If .Status <> 200 Then
                MsgBox "Server Error:  " & .Status & " - " & .StatusText
                Exit Sub
            End If
            
            PageSrc = StrConv(.ResponseBody, vbUnicode)
        End With
        
        Text = Split(PageSrc, vbLf)
        Worksheets("Sheet4").Range("A1").Resize(UBound(Text), 1).Value = Application.Transpose(Text)
                
End Sub

</code>

 

[flaviu123]

Thank you for your help. I have not explained well. I want to copy the page that contains hyperlinks (Unicode text format), not source code. What has changed in VBA code?

 

[Leith Ross]

Hello flaviu1223,

Is the result you want the same as choosing "Select All" and "Copy" from the Internet Explorer Edit menu and pasting to the worksheet?

 

[flaviu123]

No, VBA code copy and paste in workseet as text format, not Unicode text format. I think the bottom line code is the problem, but I do not know how to fix.