VBA - scraping websites videos | Excel VBA Part 46 - Querying Web Pages with Query Tables

Hello Andrew,

Your code has been working extremely well and all you advice has been amazing. However, I have tried changing the URLfrom which the data is pulled (same webiste, same page format), and it had been working. However, today, I got the following output in the first and second cells of my query: "Element HTML". I have tried re-inputing the URL, and double checked all the code, but am not sure why I am recieveing this result. I have three other queries, two that are running fine, one using the exact code you gave me last time, and the third using a new URL as well and it also is having the same "Element HTML" Below I have attached the two codes that are having issues. Please let me know your thoughts and thank you for your time.

1st Problem Code:

Sub CreateQuery()

    Dim qry As WorkbookQuery
    Dim QueryText As String
    
    QueryText = _
        "let Source = Web.Page(Web.Contents(""https://flightaware.com/resources/airport/DNMN/weather"")), " _
        & "Data1 = Source{1}[Data] in Data1"
    
    
    Set qry = ThisWorkbook.Queries.Add(Name:="MyQuery22", Formula:=QueryText)
    
    With Sheet1.ListObjects.Add( _
        SourceType:=0, _
        Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & qry.Name, _
        Destination:=Range("$A$1")).QueryTable
            .CommandType = xlCmdDefault
            .CommandText = "SELECT * FROM [" & qry.Name & "]"
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = False
            .Refresh BackgroundQuery:=False
    End With
    
End Sub

2nd Problem Code:

Sub CreateQuery()

    Dim qry As WorkbookQuery
    Dim QueryText As String
    
    QueryText = _
        "let Source = Web.Page(Web.Contents(""https://flightaware.com/resources/airport/DNIL/weather"")), " _
        & "Data1 = Source{1}[Data] in Data1"
    
    
    Set qry = ThisWorkbook.Queries.Add(Name:="MyQuery18", Formula:=QueryText)
    
    With Sheet1.ListObjects.Add( _
        SourceType:=0, _
        Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & qry.Name, _
        Destination:=Range("$A$1")).QueryTable
            .CommandType = xlCmdDefault
            .CommandText = "SELECT * FROM [" & qry.Name & "]"
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = False
            .Refresh BackgroundQuery:=True
            .ThisWorkbook.Worksheets("Sheet1").ListObjects("WorkbookQuery").QueryTable.Refresh BackgroundQuery:=False
            
            
            
    End With
    
End Sub

Hello Andrew,

Your comment about copying data from the query from each refresh is perfect thank you. I am working on setting that code up. I have been working on the code today but I got a little stuck. I have tried to comment my process on this and make it as simple as possible. I have three major areas I am struggling with:

1 - Can I use the "lastRow" dimiension in a Range("__,__") when specifiying the range of data to copy

2 - Can I use the "lastRow" dimension in a Range("__,__") when specifying the range of data to remove duplicates from and can I refresh that dimension before removing those duplicates

3 - Can I use the "lastRow" dimension in a Range("__,__") when specifiying the range of data to sort? 

4 - I am also not confident I am using the ".RemovingDuplicates" and ".Sort" functions properly.

Some extra info to help explain the code below:

 - I am using a userform to require users to run this code upon opening the spreadsheet

 - I have two worksheets "Sheet1" and "Query"

    - The "Query" worksheet houses the query which is contained in columns A:H

    - Next to the cells containing the actual query have a neighboring table which helps to filter, organize, and prepare the needed data, it is contained in cells A2:W17

- Data copied from the "Query" is pasted in the first avaliable row in "Sheet1"

- All data contains headers in row A and has filters

-I have not altered the original code you sent me other than minor location or website changes

Thank you again for your help. I look forward to hearing from you!

Code:

Private Sub CommandButton1_Click()

Dim lastRow As Long
Dim lastRowQuery As Long

'Move to Query worksheet
Sheets("Query").Select
    'Refresh Weather Data Query
    Range("A1").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

'Move to Sheet1 worksheet
Sheets("Sheet1").Select
    'Identify last open row in Sheet1
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1 'Finds last used row in column A

'Move to Query worksheet
Sheets("Query").Select
    'Identify last open row in Query
    lastRowQuery = Cells(Rows.Count, "V").End(xlUp).Row 'Finds last used row in column v

'Copy Query data to Sheet1
Range("Q2:V,lastRowQuery").Copy Destination:=Sheets(Sheet1).Cells(lastRow, "A")
    Range("A2:A,lastRowQuery").RemoveDuplicates Columns:=Array(1,lastRow), Header:x1Yes
    Range("A2:A,lastRowQuery").Sort key1:=Range("A2:A,lastRowQuery"), order1:=xlDescending, Header:=xlYes

End Sub

Hi Andrew!

Thank you for your help in trying to figure this out. I now understand why my previous code wasn't working and what you sent me is very nice! I am new to VBA and am trying to teach myself so forgive me for the stupid question here, but I am trying to import the data to an excel spreadsheet daily, and only the headers and data, no formatting or filters.

Esentially I need to import the Recent Yola METAR History, whenever the document is open, but only if there is new data. I would to keep it all in the same columns and run from newest to oldest. Esentially inserting new rows in each column for lines of data, and reorganizing from newest to oldest, all when the workbook is opened. I do know hwo to refersh on open upsing "RefreshOnFileOpen " and I do know how to offset data, so I could count the number of rows with each import and move the current data down that much with each import, but I am not sure how best to do that. Any help or advice?

Hi I tried with this .....

Sub esempio_due()
    Dim driver As New ChromeDriver
    Dim tabella As Object, r As Long, c As Integer
    With driver
         .Start "Chrome", ""
        .Get "https://tipsterarea.com/"
        .FindElementByName("search").SendKeys "Switch To Old Site"
        .FindElementByName("switch").Click
        Set tabella = driver.FindElementByTag("table")
        For Each th In tabella.FindElementsByTag("tr")
            r = r + 1: c = 1
            For Each td In th.FindElementsByTag("td")
                Cells(r, c).Value = td.text
                c = c + 1
            Next
        Next
    End With
End Sub
 

but it does not work Can you help me Thank you

Thanks Andrew.

What I have noticed is the columns DO NOT alter, ie if the query only contains 10 columns and I manually add an eleventh, after clicking refresh, the eleventh column remains.

Andrew,

I think I stumbled across a solution myself instead!

Instead of

    Range("A5").CurrentRegion.Delete

I changed it to 

     Range("A5").CurrentRegion.Clear

and after the worksheet was wiped, I could stil right-click and click refresh to retrieve the table.

Thanks again for your help.

Andrew,

Thanks for your prompt response.

I tried your code and it worked - sort of!

I put a break point in this line:

Range("A5").CurrentRegion.Delete

and could see in the immediate window that the count of query tables is 1.

After executing the Delete line, the count of query tables is still 1.

By now the worksheet contains no data. However, right-clicking on cell A5, I do not see the option to refresh the query.

I tested this in Excel 2010.

Thanks.

I found adding this line seemed to work around 90% of the time:

.BackgroundQuery = False

though I'm not sure if it was a fluke!

Thanks for the links, I will look them over.