Usando consultas na web e um loop para baixar 4.000 entradas de banco de dados de 4.000 páginas da Web - dicas do Excel

Índice

Um dia, recebi um e-mail de transmissão de Jan no PMA. Ela estava transmitindo uma grande ideia de Gary Gagliardi, da Clearbridge Publishing. Gary mencionou que alguns mecanismos de pesquisa atribuem uma classificação de página a uma página com base na quantidade de links de outros sites para a página. Ele estava sugerindo que se todos os 4.000 membros do PMA se conectassem a todos os outros 4.000 membros do PMA, isso aumentaria todas as nossas classificações. Jan achou que era uma ótima ideia e disse que todos os endereços de membros do PMA estão listados no site atual do PMA na área de membros.

Pessoalmente, acho que a teoria do "número de links" é um pouco um mito, mas estava disposto a tentar para ajudar.

Assim, visitei a área de Membros do PMA, onde rapidamente descobri que não havia uma lista única de membros, mas sim 27 listas de membros.

Visitei a área de integrantes da PMA.

Ao clicar na página "A", vi que era ainda pior. Cada link nesta página não conduzia ao site do membro. Cada link aqui leva a uma página individual no PMA-online com o site do membro.

Links na página da web.

Isso significaria que eu teria que visitar milhares de páginas da web para compilar a lista de membros. Isso seria claramente uma proposição insana.

Felizmente, sou coautor de VBA & Macros para Microsoft Excel. Gostaria de saber se eu poderia personalizar o código do livro para resolver o problema de extração de URL de membros de milhares de páginas vinculadas.

O Capítulo 14 do livro trata do uso do Excel para ler e escrever na web. Na página 335, encontrei um código que pode criar uma consulta na Web instantaneamente.

O primeiro passo foi ver se eu poderia personalizar o código do livro para produzir 27 consultas na web - uma para cada uma das letras do alfabeto e o número 1. Isso me daria várias listas de todos os links no 26 listagens de páginas em ordem alfabética.

Cada página possui um URL semelhante a http://www.pma-online.org/scripts/showmemlist.cfm?letter=A. Peguei o código da página 335 e o customizei um pouco para fazer 27 consultas na 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

Quatro itens foram personalizados no código acima.

  • Primeiro, tive que construir o URL correto. Isso foi conseguido anexando a letra apropriada ao final da string do URL.
  • Em segundo lugar, modifiquei o código para executar cada consulta em uma nova planilha na pasta de trabalho.
  • Terceiro, o código do livro estava pegando a 20ª tabela da página da web. Ao gravar uma macro puxando a tabela do PMA, descobri que precisava da 7ª tabela na página da web.
  • Quarto, depois de executar a macro, fiquei desapontado ao ver que estava obtendo os nomes dos editores, mas não os hiperlinks. O código no livro especificado .WebFormatting: = xlFormattingNone. Usando a ajuda do VBA, percebi que, se alterasse para .WebFormatting: = xlFormattingAll, obteria os hiperlinks reais.

Depois de executar esta primeira macro, eu tinha 27 planilhas, cada uma com uma série de hiperlinks parecidos com isto:

Links extraídos com hiperlinks no Excel.

A próxima etapa foi extrair o endereço com hiperlink de cada hiperlink nas 27 planilhas. Não está no livro, mas há um objeto de hiperlink no Excel. O objeto tem uma propriedade .Address que retornaria a página da web no PMA-Online com o URL desse 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

Depois de executar essa macro, finalmente descobri que havia 4119 páginas da web individuais no site do PMA. Fico feliz por não ter tentado visitar cada site individualmente!

Minha próxima meta era construir uma consulta da web para visitar cada uma das 4119 páginas da web individuais. Gravei uma macro retornando uma das páginas individuais do editor para saber que queria a tabela nº 5 de cada página. Pude ver que o nome do editor foi retornado como a quinta linha da tabela. Na maioria dos casos, o site foi retornado como a 13ª linha. No entanto, descobri que, em alguns casos, se o endereço fosse 3 linhas em vez de 2, o URL do site estaria na linha 14. Se eles tivessem 3 telefones em vez de 2, o site era empurrado para outra linha. A macro teria que ser flexível o suficiente para pesquisar talvez da linha 13 a 18 para encontrar a célula que iniciou WWW :.

Havia outro dilema. O código do livro permite que a consulta da web seja atualizada em segundo plano. Na maioria dos casos, eu observaria a consulta terminar após a conclusão da macro. Meu pensamento inicial foi permitir 40 linhas para cada editor e construir todas as 4.100 consultas em cada página. Isso exigiria 80.000 linhas de planilha e muita memória. No Excel 2002, experimentei alterar BackgroundRefresh para False. O VBA fez um bom trabalho puxando as informações para a planilha antes que a macro continuasse. Isso permitiu construir a consulta, atualizá-la, salvar os valores em um banco de dados e, em seguida, excluir a consulta. Usando esse método, nunca houve mais de uma consulta por vez na planilha.

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

Essa consulta levou mais de uma hora para ser executada. Afinal, estava fazendo o trabalho de visitar mais de 4.000 páginas da web. Funcionou sem problemas e não travou o computador ou o Excel.

Então, eu tinha um bom banco de dados em Excel com o nome do editor na coluna A e o site na coluna B. Depois de classificar por site na coluna B, descobri que mais de 1000 editores não listavam um site. Sua entrada na coluna B era um URL em branco. Classifiquei e excluí essas linhas.

Além disso, os sites listados na coluna B tinham "WWW:" antes de cada URL. Usei Editar> Substituir para alterar cada ocorrência de WWW: (com um espaço depois) para nada. Eu tinha uma boa lista de 2339 editores em uma planilha.

Lista de editores na planilha.

A última etapa foi escrever um arquivo de texto que pudesse ser copiado e colado no site de qualquer membro. A macro a seguir (adaptada do código na página 345) executou essa tarefa muito bem.

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

O resultado foi um arquivo de texto com o nome e URL de mais de 2.000 editores.

Todo o código acima foi adaptado do livro. Quando comecei, estava apenas fazendo um programa único que não imaginava rodar regularmente. No entanto, agora posso imaginar voltar ao site da PMA a cada mês ou mais para obter as listas atualizadas de URL.

Seria possível colocar todas as etapas acima em uma única 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

O Excel e o VBA forneceram uma alternativa rápida para visitar individualmente milhares de páginas da web. Em teoria, o PMA deveria ser capaz de consultar seu banco de dados e fornecer essas informações muito mais rapidamente do que usar esse método. No entanto, às vezes você está lidando com alguém que não coopera ou possivelmente não sabe como obter dados de um banco de dados que outra pessoa escreveu para ela. Neste caso, um pouco de código de macro VBA resolveu nosso problema.

Artigos interessantes...