Link to home
Start Free TrialLog in
Avatar of jana
janaFlag for United States of America

asked on

Access web contents save it to excel

Some time back we placed a question on how to read data from an internet page and save the specific content to an excel workbook (maybe it was a VBA).  We tried to search it in EE but can't find it.  So hope we can get the answer again.  We have certain web pages that we need get a specific data and save it's contents to an Excel.  For example, a user logs into a specific web page and register his work on it.  If a non-user views it, it always present the last user who saved his entry.  We want to read that user name and save it in the excel workbook.  The user name will always be in the specific location.  What is the best and automated manner in pulling data from a website into Excel?
Avatar of jana
jana
Flag of United States of America image

ASKER

Hi,

I found how to pull data: DATA >> From Web, place the link and import.  Though this imports the entire page, I need only to import a specific data.

Is there a way that I can query the data imported and extract only the contents that I want?
Avatar of jana

ASKER

Fown a VBA that actually pulls data from the page (see below):

Sub Test()
    Dim IE As Object
     
    Sheets("PPG").Select
    Range("A1:H1000") = "" ' erase previous data
    Range("A1:H1000").Select
     
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .navigate "https://www.teamrankings.com/college-football/stat/points-per-game" ' should work for any URL
        Do Until .ReadyState = 4: DoEvents: Loop
           
            x = .Document.body.innertext
            x = Replace(x, Chr(10), Chr(13))
            x = Split(x, Chr(13))
            Range("A1").Resize(UBound(x)) = Application.Transpose(x)
             
            .Quit
        End With
         
    End Sub

Open in new window


Works, because it places all the page contents in the excel.  However I need to modify this VBA to only include in the excel the line that start "CHANGE" with a numeric value at the end (I need that value).

Please advice
Avatar of Gustav Brock
You can link a worksheet with a table directly to that page - using the wizard and zero code:

Go to Data, From the Internet, paste the URL, click import.
Example attached.
GameLink.xlsx
Avatar of jana

ASKER

Yes we have done that.  We need specific area.

In the code provided I need to I need to place a condition where it line that start "CHANGE"  (please note, this is not from the site provide din the code - that was address provided by the example).

After the condition or "if" detects the line start with "CHANGE", I need to extract a numeric value at the end of that line.

Hope I have explained ok (please ask me anything)
What could we know. Please provide the correct URL.
Avatar of jana

ASKER

Just talked to my boss and was not authorize provide the link but let me see how can provide one similar.
Avatar of jana

ASKER

Ok, here is something.  For example using the same site but link https://www.teamrankings.com/football-pool-picks/, I would like to look for the word "Vegas" and copy the value next to it, in this case "contests" (see pix below) - just that word.

User generated image
Another example, on the site link https://www.londonaquaticscentre.org/swimming, I want to find the word "OLYMPIC" and get the value "VENUE" (see pix below)

User generated image
What do you think can it be done?
This code will do that:

Option Compare Database
Option Explicit

Private Declare Sub InternetCloseHandle Lib "wininet.dll" ( _
    ByVal hInet As Long)
  
Private Declare Function InternetOpenA Lib "wininet.dll" ( _
    ByVal sAgent As String, _
    ByVal lAccessType As Long, _
    ByVal sProxyName As String, _
    ByVal sProxyBypass As String, _
    ByVal lFlags As Long) _
    As Long
  
Private Declare Function InternetOpenUrlA Lib "wininet.dll" ( _
    ByVal hOpen As Long, _
    ByVal sUrl As String, _
    ByVal sHeaders As String, _
    ByVal lLength As Long, _
    ByVal lFlags As Long, _
    ByVal lContext As Long) _
    As Long
  
Private Declare Sub InternetReadFile Lib "wininet.dll" ( _
    ByVal hFile As Long, _
    ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, _
    ByRef lNumberOfBytesRead As Long)

Public Function OpenURL( _
    ByVal Url As String, _
    Optional ByVal OpenType As Long) _
    As String
    
    Const IOTPreconfig  As Long = 0
    Const IOTDirect     As Long = 1
    Const IOTProxy      As Long = 3
    
    Const INET_RELOAD = &H80000000
    
    Dim hInet           As Long
    Dim hURL            As Long
    Dim Buffer          As String * 2048
    Dim Bytes           As Long
    
    Select Case OpenType
        Case IOTPreconfig, IOTDirect, IOTProxy
            ' OK
        Case Else
            Exit Function
    End Select
    
    ' Open connection.
    hInet = InternetOpenA(vbNullString, OpenType, vbNullString, vbNullString, 0)
    hURL = InternetOpenUrlA(hInet, Url, vbNullString, 0, INET_RELOAD, 0)
    
    Do
        InternetReadFile hURL, Buffer, Len(Buffer), Bytes
        If Bytes = 0 Then Exit Do
        OpenURL = OpenURL & Left$(Buffer, Bytes)
    Loop
    
    ' Close handles.
    InternetCloseHandle hURL
    InternetCloseHandle hInet

End Function

Public Function GetUrlWord( _
    ByVal Url As String, _
    ByVal Key As String, _
    Optional ByVal Appearance As Integer = 1, _
    Optional ByVal Separator As String = " ") _
    As String
    
    Dim Parts   As Variant
    Dim Value   As String
    
    Parts = Split(OpenURL(Url), Key)
    If UBound(Parts) > LBound(Parts) Then
        ' Key found.
        If UBound(Parts) >= Appearance Then
            ' Appearnce of Key found.
            Value = Split(Parts(Appearance), Separator)(0)
        End If
    End If
    
    GetUrlWord = Value
    
End Function

Public Sub Test()

    Dim Url         As String
    Dim Key         As String
    Dim Appearance  As Integer
    Dim Separator   As String
    
    Url = "https://www.teamrankings.com/football-pool-picks/"
    Key = " vegas "
    Appearance = 1
    Separator = ","
    Debug.Print Url
    Debug.Print Key, GetUrlWord(Url, Key, Appearance, Separator)
    
    Url = "https://www.londonaquaticscentre.org/swimming"
    Key = "olympic "
    Appearance = 2
    Separator = vbLf
    Debug.Print Url
    Debug.Print Key, GetUrlWord(Url, Key, Appearance, Separator)

End Sub

Open in new window

Run the Test.
Demo is attached.
ReadUrl.accdb
Avatar of jana

ASKER

Will check it out as soon as I get to computer.

Why the access file? (our question is directed to excel - does it work also with excel?)
It should. I had Access on hand ..
Avatar of jana

ASKER

Thanx will do!
Avatar of jana

ASKER

gave this message:

User generated image
please advice
Replace with the suggested Text.
Avatar of jana

ASKER

what would be the "suggested Text"?
Sorry, should have been "expected" - the error box: Text
Avatar of jana

ASKER

Ok got it!  You meant replace it to with the message presented to me:

Option Compare Text

Open in new window


Works!

Thank you!

Reviewing and trying to understand it; couple of questions:

In the Function OpenURL, noticed that hInet  and hURL having values 13369376 and 13369384; subsequently used in the Do/Loop condition
- can you give a brief explanation and we can search the rest?

The Function GetUrlWord, tried to understand in the "If UBound(Parts)" condition on how you got that value in 'GetUrlWord'
- can you also give a brief explanation?


Greatly appreciated
ASKER CERTIFIED SOLUTION
Avatar of Gustav Brock
Gustav Brock
Flag of Denmark image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial