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.

macro excel
macro excel

 

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