Extract data from internet using a macro in an excel report
In one of my projects, I have to extract monthly data from a website by doing manually a copy and paste. Even if it was once a month, I needed to make it automatic. Here, I put 2 codes, a simple extraction into excel and another one where I can choose between 2 webpages.
When I use the macro ?
To extract data from a webpage into my report.
How to create the macro ?
Read How to create, edit, hide and select a macro in an excel report
How to create the button to associate it with the macro ?
Read How to create a button and associated it to a macro in an excel report
How is/are the macro(s) ?
Copy the code below and paste it into your macro. You will see my comments in green if exist so follow the help to adapt to your need.
Without multiple choices:
Sub test() ' change webpage by your webpage address ActiveWorkbook.FollowHyperlink Address:="webpage", NewWindow:=True ' change webpage by the same webpage address ' change A2 by the cell rerence where to paste With ActiveSheet.QueryTables.Add(Connection:="URL;webpage", Destination:=Range("A2")) ' start similar ' change myname by a name you want .Name = "myname" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlEntirePage .WebFormatting = xlWebFormattingNone .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With ' end similar End Sub
With multiple choices:
Sub test() Dim rexport As String Dim rurl As String Dim i As Object ' change Which report to extract ? by what you want ' change Yes for incident - No for problem by what you want rexport = MsgBox("Which report to extract ?" &Chr(13) & Chr(10) & "(Yes for incident - No for problem)", vbYesNo, "Open Report") If (rexport = vbYes) Then ' change incidentwebpage by your first webpage address rurl = "incidentwebpage" ' change problemwebpage by your second webpage address Else rurl = "problemwebpage" End If ' change A2 by the cell rerence where to paste With ActiveSheet.QueryTables.Add(Connection:="URL;" & rurl, Destination:=Range("A2")) ' change startend similar line by the other macro where I put between start similar - end similar startend similar ' change If more than 1 webpage, do a manual copy-paste for the other webpages by what you want MsgBox ("If more than 1 webpage, do a manual copy-paste for the other webpages") Set i = CreateObject("InternetExplorer.Application") i.Navigate rurl i.Visible = True End Sub
Interesting Topics
-
Be successfully certified ITIL 4 Managing Professional
Study, study and study, I couldn’t be successfully certified without studying it, if you are interested...
-
Be successfully certified ITIL 4 Strategic Leader
With my ITIL 4 Managing Professional certification (ITIL MP) in the pocket, it was time to go for the...
-
Hide visual and change background color based on selection
Some small tricks to customize the background colour of a text box...
-
Stacked and clustered column chart or double stacked column chart
In excel, I use a lot the combination of clustered and stacked chart...