Eines Tages erhielt ich eine E-Mail von Jan von der PMA. Sie gab eine großartige Idee von Gary Gagliardi von Clearbridge Publishing weiter. Gary erwähnte, dass einige Suchmaschinen einer Seite einen Seitenrang zuweisen, basierend darauf, wie viele andere Websites auf die Seite verlinken. Er schlug vor, dass wenn alle 4000 Mitglieder der PMA mit allen 4000 anderen Mitgliedern der PMA verknüpft würden, dies alle unsere Rankings verbessern würde. Jan hielt dies für eine großartige Idee und sagte, dass alle Webadressen der PMA-Mitglieder auf der aktuellen PMA-Website im Mitgliederbereich aufgeführt sind.
Persönlich denke ich, dass die Theorie der "Anzahl der Links" ein Mythos ist, aber ich war bereit, es zu versuchen, um zu helfen.
Also besuchte ich den PMA-Mitgliederbereich, wo ich schnell erfuhr, dass es keine einzige Mitgliederliste gab, sondern 27 Mitgliederlisten.
Als ich mich zur "A" -Seite durchklickte, sah ich, dass es noch schlimmer war. Jeder Link auf dieser Seite führte nicht zur Website des Mitglieds. Jeder Link hier führt zu einer individuellen Seite bei PMA-online mit der Website des Mitglieds.
Dies würde bedeuten, dass ich Tausende von Webseiten besuchen müsste, um die Mitgliederliste zusammenzustellen. Dies wäre eindeutig eine verrückte Aussage.
Zum Glück bin ich Mitautor von VBA & Macros für Microsoft Excel. Ich fragte mich, ob ich den Code aus dem Buch anpassen könnte, um das Problem des Extrahierens von Mitglieds-URLs aus Tausenden von verlinkten Seiten zu lösen.
In Kapitel 14 des Buches geht es um die Verwendung von Excel zum Lesen und Schreiben aus dem Web. Auf Seite 335 habe ich Code gefunden, mit dem eine Webabfrage im laufenden Betrieb erstellt werden kann.
Der erste Schritt bestand darin, zu prüfen, ob ich den Code im Buch so anpassen konnte, dass 27 Webabfragen erstellt werden konnten - eine für jeden Buchstaben des Alphabets und die Nummer 1. Dies würde mir mehrere Listen aller Links auf der Liste geben 26 alphabetische Seitenlisten.
Jede Seite hat eine ähnliche URL wie http://www.pma-online.org/scripts/showmemlist.cfm?letter=A. Ich habe Code von Seite 335 genommen und ihn ein wenig angepasst, um 27 Webabfragen durchzuführen.
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 SubEs gab vier Elemente, die im obigen Code angepasst wurden.
- Zuerst musste ich die richtige URL erstellen. Dies wurde erreicht, indem der richtige Buchstabe an das Ende der URL-Zeichenfolge angehängt wurde.
- Zweitens habe ich den Code so geändert, dass jede Abfrage in einem neuen Arbeitsblatt in der Arbeitsmappe ausgeführt wird.
- Drittens hat der Code im Buch die 20. Tabelle von der Webseite abgerufen. Durch Aufzeichnen eines Makros, das die Tabelle von PMA abruft, habe ich erfahren, dass ich die 7. Tabelle auf der Webseite benötige.
- Viertens war ich nach dem Ausführen des Makros enttäuscht zu sehen, dass ich die Namen der Herausgeber erhielt, aber nicht die Hyperlinks. Der im Buch angegebene Code .WebFormatting: = xlFormattingNone. Mithilfe der VBA-Hilfe stellte ich fest, dass ich bei einem Wechsel zu .WebFormatting: = xlFormattingAll die tatsächlichen Hyperlinks erhalten würde.
Nachdem ich dieses erste Makro ausgeführt hatte, hatte ich 27 Arbeitsblätter mit jeweils einer Reihe von Hyperlinks, die so aussahen:
Der nächste Schritt bestand darin, die Hyperlink-Adresse aus jedem Hyperlink auf den 27 Arbeitsblättern zu extrahieren. Es ist nicht im Buch enthalten, aber es gibt ein Hyperlink-Objekt in Excel. Das Objekt verfügt über eine .Address-Eigenschaft, die die Webseite in PMA-Online mit der URL für diesen Herausgeber zurückgibt.
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 SubNachdem ich dieses Makro ausgeführt hatte, erfuhr ich schließlich, dass es auf der PMA-Site 4119 einzelne Webseiten gab. Ich bin froh, dass ich nicht versucht habe, jede einzelne Site einzeln zu besuchen!
Mein nächstes Ziel war es, eine Webabfrage zu erstellen, um jede der 4119 einzelnen Webseiten zu besuchen. Ich habe ein Makro aufgezeichnet, das eine der einzelnen Herausgeberseiten zurückgibt, um zu erfahren, dass ich von jeder Seite Tabelle 5 haben möchte. Ich konnte sehen, dass der Name des Herausgebers als fünfte Zeile der Tabelle zurückgegeben wurde. In den meisten Fällen wurde die Website als 13. Zeile zurückgegeben. Ich habe jedoch erfahren, dass in einigen Fällen, wenn die Adresse 3 statt 2 Zeilen war, die Website-URL tatsächlich in Zeile 14 stand. Wenn 3 Telefone anstelle von 2 vorhanden waren, wurde die Website um eine weitere Zeile verschoben. Das Makro müsste flexibel genug sein, um von Zeile 13 bis 18 zu suchen, um die Zelle zu finden, mit der WWW: gestartet wurde.
Es gab ein anderes Dilemma. Mit dem Code im Buch kann die Webabfrage im Hintergrund aktualisiert werden. In den meisten Fällen würde ich tatsächlich beobachten, wie die Abfrage beendet wird, nachdem das Makro beendet wurde. Mein erster Gedanke war, 40 Zeilen für jeden Publisher zuzulassen und alle 4100 Abfragen auf jeder Seite zu erstellen. Dies hätte 80.000 Tabellenkalkulationszeilen und viel Speicher benötigt. In Excel 2002 habe ich mit dem Ändern von BackgroundRefresh in False experimentiert. VBA hat die Informationen gut in das Arbeitsblatt gezogen, bevor das Makro fortgesetzt wurde. Dies ermöglichte das Erstellen der Abfrage, das Aktualisieren der Abfrage, das Speichern der Werte in einer Datenbank und das Löschen der Abfrage. Bei dieser Methode gab es nie mehr als eine Abfrage gleichzeitig im Arbeitsblatt.
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 SubDie Ausführung dieser Abfrage dauerte mehr als eine Stunde. Immerhin hat es die Arbeit erledigt, über 4000 Webseiten zu besuchen. Es lief reibungslos und stürzte weder den Computer noch Excel ab.
Ich hatte dann eine schöne Datenbank in Excel mit dem Namen des Herausgebers in Spalte A und der Website in Spalte B. Nach dem Sortieren nach Website in Spalte B stellte ich fest, dass über 1000 Herausgeber keine Website auflisteten. Ihr Eintrag in Spalte B war eine leere URL. Ich habe diese Zeilen sortiert und gelöscht.
Außerdem hatten die in Spalte B aufgeführten Websites vor jeder URL "WWW:". Ich habe Bearbeiten> Ersetzen verwendet, um jedes Vorkommen von WWW: (mit einem Leerzeichen danach) in nichts zu ändern. Ich hatte eine schöne Liste von 2339 Verlagen in einer Tabelle.
Der letzte Schritt bestand darin, eine Textdatei zu schreiben, die kopiert und in die Website eines Mitglieds eingefügt werden konnte. Das folgende Makro (angepasst an den Code auf Seite 345) hat diese Aufgabe gut erledigt.
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 SubDas Ergebnis war eine Textdatei mit dem Namen und der URL von über 2000 Herausgebern.
Der gesamte obige Code wurde aus dem Buch übernommen. Als ich anfing, machte ich nur ein einmaliges Programm, das ich mir nicht vorstellen konnte, regelmäßig auszuführen. Jetzt kann ich jedoch jeden Monat oder so auf die PMA-Website zurückgreifen, um die aktualisierten Listen der URLs abzurufen.
Es wäre möglich, alle oben genannten Schritte in einem einzigen Makro zusammenzufassen.
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 SubExcel und VBA boten eine schnelle Alternative zum individuellen Besuch von Tausenden von Webseiten. Theoretisch hätte die PMA in der Lage sein müssen, ihre Datenbank abzufragen und diese Informationen weitaus schneller bereitzustellen als mit dieser Methode. Manchmal haben Sie es jedoch mit jemandem zu tun, der nicht kooperativ ist oder möglicherweise nicht weiß, wie Daten aus einer Datenbank abgerufen werden können, die jemand anderes für ihn geschrieben hat. In diesem Fall hat ein bisschen VBA-Makrocode unser Problem gelöst.
