Visual Basic para Aplicaciones - Macro para extraer información de una tabla HTML

Sub WebDataImport()

On Error GoTo ControlErr

Dim strURL As String

Dim strDestino As String, strReportName As String

Dim numConnections As Integer, i As Integer

'vars

numConnections = ThisWorkbook.Connections.Count

strDestino = "A1"

strReportName = "Reporte Mensual"

strURL = InputBox("Indique URL origen", "Mensaje")

'check url data

If strURL <> Empty Then

'custom url address

strURL = "URL;" & strURL

'clean previous connections

If numConnections > 0 Then

For i = 1 To numConnections

    ThisWorkbook.Connections(i).Delete

Next i

End If

'clean datasheet

Sheets(1).Select

Sheets(1).Cells.Clear

'control excel app

Application.ScreenUpdating = False

'get web query

With Sheets(1).QueryTables.Add(Connection:=strURL _

, Destination:=Range(strDestino))

    .Name = strReportName

    .FieldNames = True

    .RowNumbers = False

    .FillAdjacentFormulas = False

    .PreserveFormatting = True

    .RefreshOnFileOpen = False

    .BackgroundQuery = True

    .RefreshStyle = xlOverwriteCells

    .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

'control excel app

Application.ScreenUpdating = True

'final message

MsgBox "La importación ha finalizado", vbInformation, "Mensaje"

End If

Exit Sub

ControlErr:

MsgBox "Error: " & Err.Description, vbCritical, "Mensaje"

End Sub

.WebSelectionType = xlEntirePage

.WebSelectionType = xlSpecifiedTables

.WebTables = "crLive"