2017-01-25 3 views
0

Bevor ich meine Frage stellen, ich bin ein Amateur-Coder mit im Grunde keine sinnvolle Erfahrung über VBA in MS-Office-Anwendungen (ich weiß - Noob)Webseite Datentabelle Schaber

Ich versuche, einen Web-Schaber zu erstellen Mit VBA, um Daten in Excel zu importieren und gemäß meiner Kommentare in der folgenden Code-Extrakt, war das Beste, was ich in der Lage zu finden, war in der gewinnenden Antwort auf this question.

Im Folgenden benutze ich investment.com als Beispiel, aber in Wirklichkeit wird mein Projekt über mehrere Websites laufen und in eine Matrizen einfließen, die täglich aktualisiert werden und sich selbst ausnutzen können, wenn Ereignisse ablaufen - aus diesem Grund würde ich eher die Arbeitslast auf der Code-Seite, um die Eingaben auf eine laufende Basis so minimal wie möglich zu machen (für mich).

, die mit im Auge, kann ich fragen, ob es einen Weg gibt, eine der folgenden Aktionen zu tun (selbst stemmen, wird dies für einige erschaudern-würdig Grundkenntnisse):

  1. Gibt es eine Möglichkeit in was kann ich und navigieren Sie zu einer URL und führen Sie eine for each Schleife auf jeder Tabelle auf dieser Seite (ohne eine bekannte ID für alle)? Dies dient sowohl dazu, meinen Code zu beschleunigen, als auch meine Eingaben zu minimieren, da es ziemlich viele Daten zu aktualisieren gibt und ich plante, einen 2-Minuten-Looping-Trigger auf die Aktualisierung zu setzen.

  2. Anstatt zu tun, was ich unten getan habe, ist es möglich, eine Tabelle anstelle einer Zeile zu referenzieren und etwas in der Art von Cells (2,5) .value auszuführen, um den Wert innerhalb der Zeile zurückzugeben 1, Spalte 4? (Unter der Annahme, dass die Array-Indizierung in beiden Dimensionen bei 0 beginnt?) Außerdem ist meine erste Spalte (mein Primärschlüssel in mancher Hinsicht) möglicherweise nicht in der gleichen Reihenfolge in allen Quellen, also gibt es eine Möglichkeit, wie ich das machen könnte das Äquivalent zu Columns("A:A").Find(What:=[Primary key], After:=Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Row zu finden, welche Zeile in der Tabelle bezieht sich auf die gerade ich suche?

Code:

Sub Scraper() 
Dim appIE, allRowOfData As Object 

' As per https://stackoverflow.com/questions/27066963/scraping-data-from-website-using-vba 

Set appIE = CreateObject("internetexplorer.application") 

With appIE 
    .Navigate "http://uk.investing.com/rates-bonds/financial-futures" 'Sample page 
    .Visible = False 
End With 

Do While appIE.Busy 
    Application.Wait (Now + TimeValue("0:00:01")) 'If page not open, wait a second befor trying again 
Loop 

Set allRowOfData = appIE.document.getElementById("pair_8907") 
'tr id="[ID of row within table]" 
Dim myValue As String: myValue = allRowOfData.Cells(8).innerHTML 
'The 8 is the column number of the table 
'(note: column numbers start at 0 so the 9th column should have "8" entered here 

Set appIE = Nothing 

Range("A1").Value = myValue 

End Sub 
+0

Warum werde ich gewählt? – Jeremy

+0

@ R3uK Danke für die Bearbeitung - ich konnte es nicht aus irgendeinem Grund zu codieren – Jeremy

+0

Sie brauchen eine Zeile mit normalem Text zwischen Listen und Code! ;) Anscheinend wurdest du abgelehnt, weil deine Frage zu weit gefasst ist, du musst vielleicht Prioritäten setzen! ;) Und andere Frage später oder anderswo stellen (dh 3. ist nicht sehr klar und könnte auf SuperUser gefragt werden) – R3uK

Antwort

1

Wenn Sie Excel-Funktionen verwenden, um die Tabellen zu navigieren, warum nicht die Tabellen-Dump zuerst auf einem Arbeitsblatt dieser Code funktioniert für mich

Option Explicit 

Sub Scraper() 
    Dim appIE As Object 

    ' As per http://stackoverflow.com/questions/27066963/scraping-data-from-website-using-vba 

    Set appIE = CreateObject("internetexplorer.application") 

    With appIE 
     .Navigate "http://uk.investing.com/rates-bonds/financial-futures" 'Sample page 
     .Visible = True 
    End With 

    Do While appIE.Busy 
     DoEvents 
     Application.Wait (Now + TimeValue("0:00:01")) 'If page not open, wait a second befor trying again 
    Loop 

    'Debug.Print TypeName(appIE.document) 

    Dim doc As Object 'MSHTML.HTMLDocument 
    Set doc = appIE.document 

    '* appIE busy is good but you need to wait for the whole document to completely load and initialise so use this 
    While doc.readyState <> "complete" 
     DoEvents 
    Wend 

    '* we can select all the tables because they share the same CSS class name 
    Dim tablesSelectedByClass As Object 'MSHTML.HTMLElementCollection 
    Set tablesSelectedByClass = doc.getElementsByClassName("genTbl") 

    '* you can change this, it was just convenient for me to add sheets to my workbook 
    Dim shNewResults As Excel.Worksheet 
    Set shNewResults = ThisWorkbook.Worksheets.Add 

    Dim lRowCursor As Long '* this controls pasting down the sheet 
    lRowCursor = 1 

    Dim lTableIndexLoop As Long 
    For lTableIndexLoop = 0 To tablesSelectedByClass.Length - 1 

     Dim tableLoop As Object 'MSHTML.HTMLTable 
     Set tableLoop = tablesSelectedByClass.Item(lTableIndexLoop) 

     If LenB(tableLoop.ID) > 0 Then '* there are some extra nonsense tables, this subselects 

      Dim sParentColumn As String, objParentColumn As Object ' MSHTML.HTMLSemanticElement 
      Set objParentColumn = FindMyColumn(tableLoop, sParentColumn) '* need to understand is table on left hand or right hand side 

      Dim vHeader As Variant: vHeader = Empty 
      If sParentColumn = "leftColumn" Then 
       '* tables on the left have a preceding H3 element with the table's description 
       Dim objH3Headers As Object 
       Set objH3Headers = objParentColumn.getElementsByTagName("H3") 
       vHeader = objH3Headers.Item(lTableIndexLoop).innerText 
      Else 
       '* tables on the right have a hidden attribute we can use 
       vHeader = tableLoop.Attributes.Item("data-gae").Value 
       If Len(vHeader) > 3 Then 
        vHeader = Mid$(vHeader, 4) 
        Mid$(vHeader, 1, 1) = Chr(Asc(Mid$(vHeader, 1, 1)) - 32) 
       End If 
      End If 

      '* tables on the right do not have column headers 
      Dim bHasColumnHeaders As Boolean 
      bHasColumnHeaders = (tableLoop.ChildNodes.Length = 2) 

      Dim vTableCells() As Variant '* this will be our table data container which we will paste in one go 
      Dim lRowCount As Long: lRowCount = 0 
      Dim lColumnCount As Long: lColumnCount = 0 
      Dim lDataHeadersSectionIdx As Long: lDataHeadersSectionIdx = 0 
      Dim objColumnHeaders As Object: Set objColumnHeaders = Nothing 

      If bHasColumnHeaders Then 

       Set objColumnHeaders = tableLoop.ChildNodes.Item(0).ChildNodes.Item(0) 

       lRowCount = lRowCount + 1 

       lDataHeadersSectionIdx = 1 
      Else 
       lDataHeadersSectionIdx = 0 
      End If 

      Dim objDataRows As Object 'MSHTML.HTMLElementCollection 
      Set objDataRows = tableLoop.ChildNodes.Item(lDataHeadersSectionIdx).ChildNodes 
      lColumnCount = objDataRows.Item(0).ChildNodes.Length 

      lRowCount = lRowCount + objDataRows.Length 

      ReDim vTableCells(1 To lRowCount, 1 To lColumnCount) As Variant 

      '* we have them get the column headers 
      Dim lColLoop As Long 
      If bHasColumnHeaders Then 
       For lColLoop = 1 To lColumnCount 
        vTableCells(1, lColLoop) = objColumnHeaders.ChildNodes.Item(lColLoop - 1).innerText 
       Next 
      End If 

      '* get the data cells 
      Dim lRowLoop As Long 
      For lRowLoop = 1 To lRowCount - VBA.IIf(bHasColumnHeaders, 1, 0) 
       For lColLoop = 1 To lColumnCount 
        vTableCells(lRowLoop + VBA.IIf(bHasColumnHeaders, 1, 0), lColLoop) = objDataRows.Item(lRowLoop - 1).ChildNodes.Item(lColLoop - 1).innerText 
       Next 
      Next 

      '* paste our table description 
      shNewResults.Cells(lRowCursor, 1).Value2 = vHeader 
      lRowCursor = lRowCursor + 1 

      '* paste our table data 
      shNewResults.Cells(lRowCursor, 1).Resize(lRowCount, lColumnCount).Value2 = vTableCells 
      lRowCursor = lRowCursor + lRowCount + 1 
     End If 

    Next 

End Sub 

Function FindMyColumn(ByVal node As Object, ByRef psColumn As String) As Object 
    '* this code ascends the DOM looking for "column" in the id of each node 
    While InStr(1, node.ID, "column", vbTextCompare) = 0 And Not node.ParentNode Is Nothing 
     DoEvents 
     Set node = node.ParentNode 
    Wend 
    If InStr(1, node.ID, "column", vbTextCompare) > 0 Then 
     Set FindMyColumn = node 
     psColumn = CStr(node.ID) 
    End If 


End Function 

Durch die So, wenn Sie viel handeln, werden die Makler reich und Sie werden arm, Brokergebühren wirken sich auf lange Sicht wirklich aus.

+0

Sie sind sowohl ein Gentleman (oder Lady - kann nicht sagen!) Und ein Gelehrter - Danke dafür! Ich arbeite im Finanzdienstleistungsbereich und bin mir der Maklergebühren etc. bewusst. -Das obige war nur eine Beispielseite :) – Jeremy

Verwandte Themen