Uso de consultas web y un bucle para descargar 4000 entradas de base de datos desde 4000 páginas web - Consejos de Excel

Tabla de contenido

Un día, recibí un correo electrónico de Jan en la PMA. Ella estaba transmitiendo una gran idea de Gary Gagliardi de Clearbridge Publishing. Gary mencionó que algunos motores de búsqueda asignan un rango de página a una página en función de cuántos otros sitios enlazan a la página. Él estaba sugiriendo que si los 4000 miembros de la PMA se enlazaran con los otros 4000 miembros de la PMA, impulsaría todas nuestras clasificaciones. Jan pensó que era una gran idea y dijo que todas las direcciones web de los miembros de la PMA se enumeran en el sitio web actual de la PMA en el área de miembros.

Personalmente, creo que la teoría del "número de enlaces" es un poco un mito, pero estaba dispuesto a intentarlo para ayudar.

Entonces, visité el área de miembros de la PMA, donde rápidamente supe que no había una sola lista de miembros, sino 27 listas de miembros.

Visité el área de miembros de PMA.

Al hacer clic en la página "A", vi que era aún peor. Cada enlace en esta página no conducía al sitio web del miembro. Cada enlace aquí conduce a una página individual en PMA-online con el sitio web del miembro.

Enlaces en la página web.

Esto significaría que tendría que visitar miles de páginas web para compilar la lista de miembros. Claramente, esta sería una propuesta loca.

Afortunadamente, soy coautor de VBA & Macros para Microsoft Excel. Me preguntaba si podría personalizar el código del libro para resolver el problema de extraer URL de miembros de miles de páginas vinculadas.

El capítulo 14 del libro trata sobre el uso de Excel para leer y escribir en la web. En la página 335, encontré un código que podía crear una consulta web sobre la marcha.

El primer paso fue ver si podía personalizar el código en el libro para poder generar 27 consultas web, una para cada una de las letras del alfabeto y el número 1. Esto me daría varias listas de todos los enlaces en el 26 listas de páginas alfabéticas.

Cada página tiene una URL similar a http://www.pma-online.org/scripts/showmemlist.cfm?letter=A. Tomé el código de la página 335 y lo personalicé un poco para hacer 27 consultas web.

Sub CreateNewQuery() ' Page 335 Dim WSD As Worksheet Dim WSW As Worksheet Dim QT As QueryTable For m = 1 To 27 Select Case m Case 27 MyStr = "1" Case Else MyStr = Chr(64 + m) End Select MyName = "Query" & m ConnectString = "URL;http://www.pma-online.org/scripts/showmemlist.cfm?letter=" & MyStr ThisWorkbook.Worksheets.Add ActiveSheet.Name = m ' On the Workspace worksheet, clear all existing query tables For Each QT In ActiveSheet.QueryTables QT.Delete Next QT ' Define a new Web Query Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString, Destination:=Range("A1")) With QT .Name = MyName .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingAll .WebTables = "7" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False End With ' Refresh the Query QT.Refresh BackgroundQuery:=True Next m End Sub

Había cuatro elementos que se personalizaron en el código anterior.

  • Primero, tuve que construir la URL correcta. Esto se logró agregando la letra adecuada al final de la cadena de URL.
  • En segundo lugar, modifiqué el código para ejecutar cada consulta en una nueva hoja de trabajo en el libro de trabajo.
  • En tercer lugar, el código del libro estaba tomando la tabla número 20 de la página web. Al grabar una macro tirando de la tabla de PMA, aprendí que necesitaba la séptima tabla en la página web.
  • Cuarto, después de ejecutar la macro, me decepcionó ver que obtenía los nombres de los editores, pero no los hipervínculos. El código del libro especifica .WebFormatting: = xlFormattingNone. Usando la ayuda de VBA, pensé que si cambiaba a .WebFormatting: = xlFormattingAll, obtendría los hipervínculos reales.

Después de ejecutar esta primera macro, tenía 27 hojas de trabajo, cada una con una serie de hipervínculos que se veían así:

Enlaces extraídos con hipervínculos en Excel.

El siguiente paso fue extraer la dirección con hipervínculo de cada hipervínculo en las 27 hojas de trabajo. No está en el libro, pero hay un objeto de hipervínculo en Excel. El objeto tiene una propiedad .Address que devolvería la página web dentro de PMA-Online con la URL de ese editor.

Sub GetEmAll() NextRow = 1 Dim WSD As Worksheet Dim WS As Worksheet Set WSD = Worksheets("Sheet1") For Each WS In ActiveWorkbook.Worksheets If Not WS.Name = "Sheet1" Then For Each cll In WS.UsedRange.Cells For Each hl In cll.Hyperlinks WSD.Cells(NextRow, 1).Value = hl.Address NextRow = NextRow + 1 Next hl Next cll End If Next WS End Sub

Después de ejecutar esta macro, finalmente supe que había 4119 páginas web individuales en el sitio de PMA. ¡Me alegra no haber intentado visitar cada sitio individual de uno en uno!

Mi siguiente objetivo era crear una consulta web para visitar cada una de las 4119 páginas web individuales. Grabé una macro que mostraba una de las páginas del editor individual para saber que quería la tabla n. ° 5 de cada página. Pude ver que el nombre del editor se devolvió como la quinta fila de la tabla. En la mayoría de los casos, el sitio web se devolvió como la fila 13. Sin embargo, me enteré de que en algunos casos, si la dirección postal era de 3 líneas en lugar de 2, la URL del sitio web estaba en la fila 14. Si tenían 3 teléfonos en lugar de 2, el sitio web se desplazaba hacia abajo en otra fila. La macro tendría que ser lo suficientemente flexible como para buscar quizás desde la fila 13 a la 18 para encontrar la celda que inició WWW :.

Había otro dilema. El código del libro permite que la consulta web se actualice en segundo plano. En la mayoría de los casos, vería finalizar la consulta después de que finalizara la macro. Mi idea inicial fue permitir 40 filas para cada editor y crear las 4100 consultas en cada página. Esto habría requerido 80.000 filas de hojas de cálculo y mucha memoria. En Excel 2002, experimenté cambiando BackgroundRefresh a False. VBA hizo un buen trabajo al incluir la información en la hoja de trabajo antes de que la macro continuara. Esto permitió crear la consulta, actualizar la consulta, guardar los valores en una base de datos y luego eliminar la consulta. Con este método, nunca hubo más de una consulta a la vez en la hoja de trabajo.

Sub AllQuery() Dim WS As Worksheet Dim WD As Worksheet Set WD = Worksheets("database") Set WS = Worksheets("Sheet1") Dim QT As QueryTable WS.Activate OutCol = 8 OutRow = 1 FinalRow = WS.Cells(65536, 1).End(xlUp).Row For i = 2 To FinalRow ConnectString = "URL;" & WD.Cells(i, 12).Value Application.StatusBar = i ' Save after every 500 queries If i Mod 500 = 0 Then ThisWorkbook.Save End If MyName = "Query" & i ' Define a new Web Query Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString, Destination:=WS.Cells(OutRow, OutCol)) With QT .Name = MyName .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "5" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False End With ' Refresh the Query QT.Refresh BackgroundQuery:=False ' Change from a live query to values WS.Cells(OutRow, OutCol).Resize(40, 2).Value = WS.Cells(OutRow, OutCol).Resize(40, 2).Value For Each QT In WS.QueryTables QT.Delete Next QT ' Copy to Database WD.Cells(i, 1).Value = WS.Cells(5, 8).Value For j = 13 To 20 CheckIt = WS.Cells(j, 8).Value If Left(CheckIt, 3) = "WWW" Then WD.Cells(i, 8).Value = CheckIt End If Next j Next i End Sub

Esta consulta tardó más de una hora en ejecutarse. Después de todo, estaba haciendo el trabajo de visitar más de 4000 páginas web. Funcionó sin problemas y no bloqueó la computadora ni Excel.

Luego tuve una buena base de datos en Excel con el nombre del editor en la columna A y el sitio web en la columna B. Después de ordenar por sitio web en la columna B, descubrí que más de 1000 editores no incluían un sitio web. Su entrada en la columna B era una URL en blanco. Ordené y eliminé estas filas.

Además, los sitios web enumerados en la columna B tenían "WWW:" antes de cada URL. Utilicé Editar> Reemplazar para cambiar cada aparición de WWW: (con un espacio después) a nada. Tenía una buena lista de 2339 editores en una hoja de cálculo.

Lista de editores en la hoja de cálculo.

El último paso fue escribir un archivo de texto que se pudiera copiar y pegar en el sitio web de cualquier miembro. La siguiente macro (adaptada del código en la página 345) manejó esta tarea muy bien.

Sub WriteHTML() On Error Resume Next Kill "C:PMALinks.txt" On Error GoTo 0 Open "C:PMALinks.txt" For Output As #1 Print #1, "Visit the websites of our fellow PMA members:


    " For i = 2 To 2340 MyStr = "

  • " & Cells(i, 1).Value & "" Print #1, MyStr Next i Print #1, "
    • 


" Close #1 End Sub

El resultado fue un archivo de texto con el nombre y la URL de más de 2000 editores.

Todo el código anterior fue adaptado del libro. Cuando comencé, estaba haciendo un programa único que no imaginaba que se ejecutara con regularidad. Sin embargo, ahora puedo crear imágenes volviendo al sitio web de la PMA cada mes para obtener las listas actualizadas de URL.

Sería posible poner todos los pasos anteriores en una sola macro.

Sub DoEverything() Dim WSW As Worksheet Dim WST As Worksheet Set WSW = Worksheets("Workspace") Set WST = Worksheets("Template") On Error Resume Next Kill "C:AutoLinks.txt" On Error GoTo 0 Open "C:PMALinks.txt" For Output As #1 Print #1, "Visit the websites of our fellow PMA members:


    " For m = 1 To 27 Select Case m Case 27 MyStr = "1" Case Else MyStr = Chr(64 + m) End Select MyName = "Query" & m ConnectString = "URL;http://www.pma-online.org/scripts/showmemlist.cfm?letter=" & MyStr ' On the Workspace worksheet, clear all existing query tables For Each QT In WSW.QueryTables QT.Delete Next QT ' Define a new Web Query Set QT = WSW.QueryTables.Add(Connection:=ConnectString, Destination:=WSW.Range("A1")) With QT .Name = MyName .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingAll .WebTables = "7" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False End With ' Refresh the Query QT.Refresh BackgroundQuery:=False ' Next, loop through all of the hyperlinks in the resulting page For Each cll In WSW.UsedRange.Cells For Each hl In cll.Hyperlinks MyURL = hl.Address ' Build a web query on WST ConnectString = "URL;" & MyURL MyName = "Query" & NextRow ' Define a new Web Query Set QT = WST.QueryTables.Add(Connection:=ConnectString, Destination:=WST.Cells(1, 1)) With QT .Name = MyName .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "5" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False End With ' Refresh the Query QT.Refresh BackgroundQuery:=False ' Change from a live query to values WST.Cells(1, 1).Resize(40, 2).Value = WST.Cells(1, 1).Resize(40, 2).Value For Each QT In WS.QueryTables QT.Delete Next QT ' Find URL ThisPub = WS.Cells(5, 8).Value ThisURL = "WWW: http://" For j = 13 To 20 CheckIt = WS.Cells(j, 8).Value If Left(CheckIt, 3) = "WWW" Then ThisURL = CheckIt End If Next j If Not ThisURL = "WWW: http://" Then ' write a record to the .txt file MyStr = "

  • " & ThisPub & "" Print #1, MyStr End If Next hl Next cll Next m Print #1, "
    • 


" Close #1 End Sub

Excel y VBA proporcionaron una alternativa rápida a la visita individual de miles de páginas web. En teoría, la PMA debería haber podido consultar su base de datos y proporcionar esta información mucho más rápidamente que con este método. Sin embargo, a veces se trata de alguien que no coopera o que posiblemente no sabe cómo obtener datos de una base de datos que otra persona escribió para ellos. En este caso, un poco de código de macro VBA resolvió nuestro problema.

Articulos interesantes...

Recomendado