Macro para datos de pagina web

[marcoA]

Hola tengo el siguiente problema, necesito copiar datos de una tabla de una pagina web pero dentro de cada dato hay un link en el cual tengo que copiar la información para ese dato y repetir esto con cada dato de la tabla.

Más específicamente tengo que ingresar a esta pagina https://www.airfleets.net/listing/b737ng-1.htm y copiar los datos de MSN, LN, Type y status. Posterior a esto tengo que ingresar en el link correspondiente a esa fila pero de la columna Registration (https://www.airfleets.net/ficheapp/plan ... -27835.htm para el caso del primer dato) y copiar la información que aparece en las columnas Delivery date, Airline, Registration y Remark. Una vez completo esto repito el proceso para el siguiente dato y por las siguientes paginas que son cerca de 149. Si alguien me puede ayudar con este proceso de doble loops se lo agradecería mucho.


Editdo por: RMG, no esta permitido poner enlaces que no esten relacionados sobre temas tratados en el foro.

[mauricio]

El vínculo de la primer columna (MSN) es el mismo de la columna Registration.

Con Python es trivial, pero con los datos de tu firma no estaría tan seguro... si nunca has programado, no te será fácil, y no se si alguien por aquí tenga el tiempo para hacerlo, considera contratar el servicio.

Saludos

[marcoA]

si toda la razón, tengo una persona trabajando en eso pero no le ha sido muy fácil por eso recurrí al foro.

[mauricio]

Después de todo no esta tan trivial, el problema es que la página esta "detrás" de CloudFlare, pero... "casi" todo es posible.

[marcoA]

Si hasta ahí lo hemos logrado, el problema es la segunda parte que es ingresar al link de cada dato para copiar la información y volver a repetir el proceso con el siguiente registro de la pagina inicial. De ante mano muchas gracias por tus comentarios.

[mauricio]

Veo que de los datos faltantes, solo son diferentes Delivery date y Remark, tanto Airline como Registration parecen ser los mismos datos del primer listado

[mauricio]

Solo hagan un nuevo ciclo para todos los datos de la primer columna...

[physic]

saludos ,

ya hace unos días que busco una solución Python para un problema muy parecido a este del amigo marcoA .

si alguien tiene una sugerencia de macro Python para este problema, seré muy agradecido desde ahora .

encontré un ejemplo de macro Basic aquí .

abrazos .

[mauricio]

El ejemplo que enlazas al final, usan Python, pero... sin ver lo que quieres "realmente" es difícil ayudarte. Abre un nuevo tema detallando claramente que tienes y que esperas obtener, para ver que se puede hacer.

Saludos

[physic]

He intentado utilizar el código python del ejemplo, pero no funcionó para mí .

si funciona para mí, tal vez podría utilizar en mi otro modelo que estoy estudiar .

He descargado el APSO a LibreOffice y la IDE Comunidad PyCharm para editar scripts de Python, pero el ejemplo no funciona para mí .

[marcoA]

hemos logrado armar algo pero aun no logro copiar los datos anexados al link de cada fila de la primera tabla

Código: Seleccionar todo

Sub WebDataImport()
'---------------------
On Error GoTo ControlErr

Dim strURL As String
Dim strDestino As String, strReportName As String
Dim numConnections As Integer, i As Integer
Dim pag As Integer, num_pag As Integer

 

'vars
numConnections = ThisWorkbook.Connections.Count
strDestino = "A1"
strReportName = "Reporte Mensual"
'strURL = InputBox("Indique URL origen", "Mensaje")
strURL = "https://www.airfleets.net/listing/f50-1.htm"


'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
 
MsgBox "Importando datos"

'control excel app
Application.ScreenUpdating = False
 
num_pag = 5

For pag = 1 To num_pag
    strURL = "URL;https://www.airfleets.net/listing/f50-1" & pag & ".htm"
    strDestino = "A" & (1 + 100 * (pag - 1))
    
    '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

Next pag

'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

Sub Genera_hoja2()
'Carga datos en la segunda hoja
'------------------------
Dim strURL As String, strDest As String
Dim strnum As String
Dim i As Integer, j As Integer

'clean previous connections
If numConnections > 0 Then
    For i = 1 To numConnections
        ThisWorkbook.Connections(i).Delete

    Next i
End If
'filas en las hojas
i = 1
j = 1

'control excel app
Application.ScreenUpdating = True

Worksheets("Hoja1").Activate
While Range("B" & i).Value <> "*"
    Range("A" & i & ":I" & i).Copy
    If IsEmpty(Range("B" & i).Value) Then
       'celda en blanco, solo copia la linea
        Worksheets("Hoja2").Activate
        Range("A" & j).PasteSpecial xlPasteAll
        j = j + 1
    Else
    If IsNumeric(Range("B" & i).Value) Then
        strnum = CStr(Range("B" & i).Value)
              
  '            MsgBox "numero: ", Range("B" & i).Value
              
        Worksheets("Hoja2").Activate
        Range("A" & j).PasteSpecial xlPasteAll
       
        'accede a la direccion web
        j = j + 1
        strURL = "URL;https://www.airfleets.net/ficheapp/plane-f50-10685" & strnum & ".htm"

        strDest = "A" & j
        With ActiveSheet.QueryTables.Add(Connection:=strURL, Destination:=Range(strDest))
            .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
        j = j + 46
    Else
        'celda contiene algun texto, solo copia la linea
        Worksheets("Hoja2").Activate
        Range("A" & j).PasteSpecial xlPasteAll
        j = j + 1
    End If
    End If
    i = i + 1
    Worksheets("Hoja1").Activate
Wend

'control excel app
Application.ScreenUpdating = True


'final message
MsgBox "La importación de hoja2 ha finalizado", vbInformation, "Mensaje"


End Sub


Sub pruebas()
Dim i As Integer


Worksheets(1).Activate
i = 43
If Not IsEmpty(Range("B" & i).Value) Then
    MsgBox "celda B" & i & "NO esta vacia"
Else
    MsgBox "celda B" & i & " SI esta vacia"
End If
    
If IsNumeric(Range("B" & i).Value) Then
    
    MsgBox "Valor es numerico; =" & Range("B" & i).Value
Else
    MsgBox "No es numerico" & Range("B" & i).Value
End If

End Sub

si alguien tiene alguna idea de que puede estar fallando?

[mauricio]

El código que muestras NO es de LibreOffice/OpenOffice, si no de VBA... en estos foros NO damos soporte a Excel.

[fornelasa]

Si, ademas de ser una consulta para excel, la pagina se cuelga después de equis requerimientos y marca este error:

The HTTP 429 Too Many Requests response status code indicates the user has sent too many requests in a given amount of time ("rate limiting").
A Retry-After header might be included to this response indicating how long to wait before making a new request.

Saludos, Federico.