Create a Macro to Get Data from Web

ArielCamara

New Member
Joined
Sep 1, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hi there. I am a rookie and I've been trying to get some data automatically from several webpages in web using Excel + Macro + Get Data function wihtout any success.
I'm trying to get a Sheet with the data from this website. As you can see the end of it is the date "190622", so the idea is to use this:

ActiveWorkbook.Queries.Add Name:="Table 0", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://www.cndc.bo/media/archivos/boletindiario/precmp_190622.htm""))," & Chr(13) & "" & Chr(10) & " Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}, {""Column6"", type text}, {""Column" & _
"7"", type text}, {""Column8"", type text}, {""Column9"", type text}, {""Column10"", type text}, {""Column11"", type text}, {""Column12"", type text}, {""Column13"", type text}, {""Column14"", type text}, {""Column15"", type text}, {""Column16"", type text}, {""Column17"", type text}, {""Column18"", type text}, {""Column19"", type text}, {""Column20"", type text}, {" & _
"""Column21"", type text}, {""Column22"", type text}, {""Column23"", type text}, {""Column24"", type text}, {""Column25"", type text}, {""Column26"", type text}, {""Column27"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 0]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_0"
.Refresh BackgroundQuery:=False
End With
Application.CommandBars("Queries and Connections").Visible = False

And make the website a variable and change it day to day from 010120 up to 311221
Does anyone knows a way to do it?


Thanks!
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Not pretty but real close to a solution ....

VBA Code:
Option Explicit

Sub Test()
    Dim IE As Object
    
    Sheets("Sheet1").Select
    Range("A1:A1000") = "" ' erase previous data
    Range("A1").Select
    
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .navigate "https://www.cndc.bo/media/archivos/boletindiario/precmp_190622.htm" ' should work for any URL
        Do Until .readyState = 4: DoEvents: Loop
    End With


    IE.ExecWB 17, 0 '// SelectAll
    IE.ExecWB 12, 2 '// Copy selection
    ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
    Range("A1").Select
    IE.Quit
    IE.Quit ' just to make sure
    
  
'
' Macro1 Macro
'

'
    Rows("1:7").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
        , 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
        Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array( _
        25, 1), Array(26, 1), Array(27, 1)), TrailingMinusNumbers:=True
End Sub
 
Upvote 0
Hi there. I am a rookie and I've been trying to get some data automatically from several webpages in web using Excel + Macro + Get Data function wihtout any success.
I'm trying to get a Sheet with the data from this website. As you can see the end of it is the date "190622", so the idea is to use this:

And make the website a variable and change it day to day from 010120 up to 311221
Does anyone knows a way to do it?

Try this macro, which uses your code and loops through the dates from 010120 to 311221, though I've limited it to 3 dates so that you can see that it works. It adds a new sheet for each date.

VBA Code:
Public Sub Query_Loop_URL_Dates()

    Dim startDate As Date, endDate As Date, URLdate As Date
    Dim p1 As Long, p2 As Long
  
    startDate = DateValue("01/01/2020")
    endDate = DateValue("31/12/2021")
    endDate = startDate + 2             'only 3 dates for test purposes
  
    ActiveWorkbook.Queries.Add Name:="Table 0", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://www.cndc.bo/media/archivos/boletindiario/precmp_190622.htm""))," & Chr(13) & "" & Chr(10) & " Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}, {""Column6"", type text}, {""Column" & _
        "7"", type text}, {""Column8"", type text}, {""Column9"", type text}, {""Column10"", type text}, {""Column11"", type text}, {""Column12"", type text}, {""Column13"", type text}, {""Column14"", type text}, {""Column15"", type text}, {""Column16"", type text}, {""Column17"", type text}, {""Column18"", type text}, {""Column19"", type text}, {""Column20"", type text}, {" & _
        """Column21"", type text}, {""Column22"", type text}, {""Column23"", type text}, {""Column24"", type text}, {""Column25"", type text}, {""Column26"", type text}, {""Column27"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""

    For URLdate = startDate To endDate
  
        'Change URL in query formula with this date
      
        With ActiveWorkbook.Queries("Table 0")
            p1 = InStr(.Formula, "Web.Contents(")
            p1 = InStr(p1, .Formula, """")
            p2 = InStr(p1 + 1, .Formula, """")
            .Formula = Left(.Formula, p1) & "https://www.cndc.bo/media/archivos/boletindiario/precmp_" & Format(URLdate, "ddmmyy") & ".htm" & Mid(.Formula, p2)
        End With
      
        ActiveWorkbook.Worksheets.Add
        ActiveSheet.Name = Format(URLdate, "ddmmyy")
        With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
            "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0"";Extended Properties=""""" _
            , Destination:=Range("$A$1")).QueryTable
            .CommandType = xlCmdSql
            .CommandText = Array("SELECT * FROM [Table 0]")
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
            '.ListObject.DisplayName = "Table_0"
            .Refresh BackgroundQuery:=False
        End With

    Next
  
    MsgBox "Done"
  
End Sub
 
Last edited:
Upvote 0
Solution
Try this macro, which uses your code and loops through the dates from 010120 to 311221, though I've limited it to 3 dates so that you can see that it works. It adds a new sheet for each date.

VBA Code:
Public Sub Query_Loop_URL_Dates()

    Dim startDate As Date, endDate As Date, URLdate As Date
    Dim p1 As Long, p2 As Long
 
    startDate = DateValue("01/01/2020")
    endDate = DateValue("31/12/2021")
    endDate = startDate + 2             'only 3 dates for test purposes
 
    ActiveWorkbook.Queries.Add Name:="Table 0", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://www.cndc.bo/media/archivos/boletindiario/precmp_190622.htm""))," & Chr(13) & "" & Chr(10) & " Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}, {""Column6"", type text}, {""Column" & _
        "7"", type text}, {""Column8"", type text}, {""Column9"", type text}, {""Column10"", type text}, {""Column11"", type text}, {""Column12"", type text}, {""Column13"", type text}, {""Column14"", type text}, {""Column15"", type text}, {""Column16"", type text}, {""Column17"", type text}, {""Column18"", type text}, {""Column19"", type text}, {""Column20"", type text}, {" & _
        """Column21"", type text}, {""Column22"", type text}, {""Column23"", type text}, {""Column24"", type text}, {""Column25"", type text}, {""Column26"", type text}, {""Column27"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""

    For URLdate = startDate To endDate
 
        'Change URL in query formula with this date
     
        With ActiveWorkbook.Queries("Table 0")
            p1 = InStr(.Formula, "Web.Contents(")
            p1 = InStr(p1, .Formula, """")
            p2 = InStr(p1 + 1, .Formula, """")
            .Formula = Left(.Formula, p1) & "https://www.cndc.bo/media/archivos/boletindiario/precmp_" & Format(URLdate, "ddmmyy") & ".htm" & Mid(.Formula, p2)
        End With
     
        ActiveWorkbook.Worksheets.Add
        ActiveSheet.Name = Format(URLdate, "ddmmyy")
        With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
            "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0"";Extended Properties=""""" _
            , Destination:=Range("$A$1")).QueryTable
            .CommandType = xlCmdSql
            .CommandText = Array("SELECT * FROM [Table 0]")
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
            '.ListObject.DisplayName = "Table_0"
            .Refresh BackgroundQuery:=False
        End With

    Next
 
    MsgBox "Done"
 
End Sub
It worked Perfectly. Thank you so much.
 
Upvote 0

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top