Sub WebDataImport()
On Error GoTo ControlErr
 
Dim strURL As String
Dim strDestino As String, strReportName As String
Dim numConnections As Integer, i As Integer
 
Application.DisplayAlerts = False               'omitimos los mensajes de aviso
'vars
numConnections = ThisWorkbook.Connections.Count
strDestino = "A1"
strReportName = "Número de serie"
strURL = Hostname

'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("Match").Select
'Range("A1").Select
'    Selection.QueryTable.Delete
'    Selection.QueryTable.Delete
'    Selection.QueryTable.Delete
'    Selection.ClearContents

Sheets("Match").Cells.Clear
 
'control excel app
Application.ScreenUpdating = False
 
  'Dim t As Single 'Inicia el cronómetro
  't = Timer
  'get web query
With Sheets("Match").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 = 2
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    'If Timer - t > 10 Then
    '    Resume Next
    'End If
    'Application.Wait (Now + TimeValue("0:00:10"))
    'Selection.QueryTable.Refresh BackgroundQuery:=False
End With
'MsgBox Timer - t, vbInformation, "Segundos" ' Muestra el tiempo transcurrido

'If Range(strDestino) = Empty Then
Application.Wait (Now + TimeValue("0:00:5"))
BackgroundQuery = False

'End If
'control excel app
Application.ScreenUpdating = True

Application.DisplayAlerts = True
Caunt2 = Caunt2 + 1 - 2
MyTitle = "Hostname " & Caunt2 & " de " & Caunt1
'final message
'Answer = MsgBox("Do you want to continue ?", vbYesNo + vbQuestion, MyTitle)
'If Answer = 6 Then
'    Else
'    End
'    Exit Sub
'End If


End If

Exit Sub
 
ControlErr:
Range(Cells(1, 1), Cells(1, 1)) = ""
'MsgBox "Error: " & Err.Description, vbCritical, "Mensaje"
  
End Sub