Estaba fuera de las pistas, pero he vuelto, y quería ver la posibilidad que me puedan dar una mano con lo siguiente:
Tengo una Macro que actualiza información proveniente de distintos sitios web, el problema es que muchas veces algunos sitios se encuentran muy lentos, o simplemente no disponibles, entonces la Macro queda eternamente esperando respuesta. Es posible indicarle al Query, que continúe con el siguiente sitio después de un tiempo determinado, para evitar que la Macro se demore demasiado?
Gracias,
Adjunto código:
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
Estimados gusto en saludarlos,
Estaba fuera de las pistas, pero he vuelto, y quería ver la posibilidad que me puedan dar una mano con lo siguiente:
Tengo una Macro que actualiza información proveniente de distintos sitios web, el problema es que muchas veces algunos sitios se encuentran muy lentos, o simplemente no disponibles, entonces la Macro queda eternamente esperando respuesta. Es posible indicarle al Query, que continúe con el siguiente sitio después de un tiempo determinado, para evitar que la Macro se demore demasiado?
Gracias,
Adjunto código:
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
Fichero.txt
Editado el por afigueroaf
Ortografía + código VBA