Utilizzo di query Web e un ciclo per scaricare 4000 voci di database da 4000 pagine Web - Suggerimenti per Excel

Sommario

Un giorno, ho ricevuto un'e-mail di trasmissione da Jan al PMA. Stava trasmettendo una grande idea di Gary Gagliardi di Clearbridge Publishing. Gary ha detto che alcuni motori di ricerca assegnano un page rank a una pagina in base al numero di altri siti collegati alla pagina. Stava suggerendo che se tutti i 4000 membri della PMA si collegassero a tutti gli altri 4000 membri della PMA, aumenterebbe tutte le nostre classifiche. Jan ha pensato che fosse una grande idea e ha detto che tutti gli indirizzi web dei membri PMA sono elencati nel sito web corrente di PMA nell'area membri.

Personalmente, penso che la teoria del "numero di collegamenti" sia un po 'un mito, ma ero disposto a provarlo per dare una mano.

Quindi, ho visitato l'area Membri PMA, dove ho imparato rapidamente che non c'era un unico elenco di membri, ma in realtà 27 elenchi di membri.

Ho visitato l'area Membri della PMA.

Quando ho cliccato sulla pagina "A", ho visto che era anche peggio. Ogni collegamento in questa pagina non portava al sito web del membro. Ogni collegamento qui conduce a una singola pagina su PMA-online con il sito Web del membro.

Collegamenti nella pagina web.

Ciò significherebbe che dovrei visitare migliaia di pagine web per compilare l'elenco dei membri. Questa sarebbe chiaramente una proposta folle.

Fortunatamente, sono il coautore di VBA e macro per Microsoft Excel. Mi chiedevo se potevo personalizzare il codice dal libro per risolvere il problema dell'estrazione degli URL dei membri da migliaia di pagine collegate.

Il capitolo 14 del libro tratta dell'utilizzo di Excel per leggere e scrivere sul Web. A pagina 335, ho trovato codice che potrebbe creare una query web al volo.

Il primo passo è stato vedere se potevo personalizzare il codice nel libro per essere in grado di produrre 27 query web, una per ciascuna delle lettere dell'alfabeto e il numero 1. Ciò mi avrebbe fornito diversi elenchi di tutti i collegamenti sul 26 elenchi di pagine in ordine alfabetico.

Ogni pagina ha un URL simile a http://www.pma-online.org/scripts/showmemlist.cfm?letter=A. Ho preso il codice dalla pagina 335 e l'ho personalizzato un po 'per fare 27 query 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

C'erano quattro elementi che sono stati personalizzati nel codice precedente.

  • Per prima cosa, ho dovuto creare l'URL corretto. Ciò è stato ottenuto aggiungendo la lettera corretta alla fine della stringa dell'URL.
  • In secondo luogo, ho modificato il codice per eseguire ogni query su un nuovo foglio di lavoro nella cartella di lavoro.
  • Terzo, il codice nel libro stava prendendo la ventesima tabella dalla pagina web. Registrando una macro estraendo la tabella da PMA, ho appreso che avevo bisogno della settima tabella sulla pagina web.
  • Quarto, dopo aver eseguito la macro, sono rimasto deluso nel vedere che stavo ottenendo i nomi degli editori, ma non i collegamenti ipertestuali. Il codice nel libro specificato .WebFormatting: = xlFormattingNone. Usando la guida di VBA, ho pensato che se passassi a .WebFormatting: = xlFormattingAll, avrei ottenuto i collegamenti ipertestuali effettivi.

Dopo aver eseguito questa prima macro, avevo 27 fogli di lavoro, ciascuno con una serie di collegamenti ipertestuali che assomigliavano a questo:

Collegamenti estratti con collegamenti ipertestuali in Excel.

Il passaggio successivo è stato quello di estrarre l'indirizzo con collegamento ipertestuale da ogni collegamento ipertestuale sui 27 fogli di lavoro. Non è nel libro, ma c'è un oggetto collegamento ipertestuale in Excel. L'oggetto ha una proprietà .Address che restituirebbe la pagina web all'interno di PMA-Online con l'URL di quell'editore.

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

Dopo aver eseguito questa macro, ho finalmente scoperto che c'erano 4119 pagine web individuali nel sito PMA. Sono contento di non aver provato a visitare ogni singolo sito uno alla volta!

Il mio prossimo obiettivo era creare una webquery per visitare ciascuna delle 4119 singole pagine web. Ho registrato una macro che restituisce una delle singole pagine dell'editore per apprendere che volevo la tabella n. 5 da ogni pagina. Ho potuto vedere che il nome dell'editore è stato restituito come quinta riga della tabella. Nella maggior parte dei casi, il sito Web è stato restituito come 13a riga. Tuttavia, ho appreso che in alcuni casi, se l'indirizzo era di 3 righe invece di 2, l'URL del sito web era effettivamente sulla riga 14. Se avevano 3 telefoni invece di 2, il sito web veniva spinto verso il basso di un'altra riga. La macro dovrebbe essere abbastanza flessibile da cercare forse dalla riga 13 alla 18 per trovare la cella che ha avviato WWW :.

C'era un altro dilemma. Il codice nel libro consente alla query web di aggiornarsi in background. Nella maggior parte dei casi, guarderei effettivamente la fine della query al termine della macro. Il mio pensiero iniziale era di consentire 40 righe per ogni editore e di creare tutte le 4100 query su ogni pagina. Ciò avrebbe richiesto 80.000 righe di foglio di calcolo e molta memoria. In Excel 2002, ho provato a modificare BackgroundRefresh in False. VBA ha fatto un buon lavoro nel inserire le informazioni nel foglio di lavoro prima che la macro andasse avanti. Ciò consentiva di creare la query, aggiornare la query, salvare i valori in un database, quindi eliminare la query. Utilizzando questo metodo, non c'era mai più di una query alla volta nel foglio di lavoro.

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

Questa query ha richiesto più di un'ora per essere eseguita. Dopo tutto, stava facendo il lavoro di visitare oltre 4000 pagine web. Ha funzionato senza intoppi e non ha bloccato il computer o Excel.

Ho quindi avuto un bel database in Excel con il nome dell'editore nella colonna A e il sito Web nella colonna B. Dopo l'ordinamento per sito Web nella colonna B, ho scoperto che oltre 1000 editori non elencavano un sito Web. La loro voce nella colonna B era un URL vuoto. Ho ordinato ed eliminato queste righe.

Inoltre, i siti web elencati nella colonna B avevano "WWW:" prima di ogni URL. Ho usato Modifica> Sostituisci per cambiare ogni occorrenza di WWW: (con uno spazio dopo) in niente. Avevo una bella lista di 2339 editori su un foglio di calcolo.

Elenco degli editori nel foglio di lavoro.

L'ultimo passaggio è stato scrivere un file di testo che potesse essere copiato e incollato nel sito Web di qualsiasi membro. La seguente macro (adattata dal codice a pagina 345) ha gestito bene questa operazione.

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

Il risultato è stato un file di testo con il nome e l'URL di oltre 2000 editori.

Tutto il codice sopra è stato adattato dal libro. Quando ho iniziato, stavo semplicemente facendo un programma una tantum che non immaginavo di eseguire regolarmente. Tuttavia, ora posso immaginare di tornare al sito Web di PMA ogni mese circa per ottenere gli elenchi aggiornati di URL.

Sarebbe possibile mettere tutti i passaggi precedenti in una singola 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 e VBA hanno fornito una rapida alternativa alla visita individuale di migliaia di pagine Web. In teoria, il PMA avrebbe dovuto essere in grado di interrogare il proprio database e fornire queste informazioni molto più rapidamente rispetto all'utilizzo di questo metodo. Tuttavia, a volte hai a che fare con qualcuno che non collabora o forse non sa come estrarre dati da un database che qualcun altro ha scritto per loro. In questo caso, un po 'di codice macro VBA ha risolto il nostro problema.

Articoli interessanti...