#

Download:

Datei 1: Serial_Emails_Excel_with_Word_version54.xlsm
Datei 2: Text_for_Excel.docx

MS Access Download: Web Roboter Anwendung

 

Diese Anwendung enthält eine komplette Web Roboter Lösung in Form einer Microsoft MS Access datenbank,

welche voll automatisch eine Domain, Website lesen und erfassen kann und alle Links und Inhalte in einer Datenbank ablegt.

 

Betrifft: Download Webscraping, Webroboter, Suchmaschine

Geschrieben unter Microsoft Access, (2007, 2010, 2013 2015) mit vba Code und dem webbrowser Steuerelement und mit mshtml

 

Dabei werden alle Webseiten einer Internet Domain erfasst und in einer Tabelle abgelegt

 

 

Die Datenbank und der vba Code können für eigene Projekte gerne angepasst und weiter verwendet werden.

 

Anpassungen

Alles was man für die eigenen Verwendung machen muss, ist in der Tabelle tbl_Keydata die URL der Startseite eintragen, welche gelesen werden soll.

 

 

Tabellen:

In der Tabelle tbl_KeyData werden die Startseite und die Domain eingestellt.

In der Tabelle tbl_Pages werden die Ergebnisse gesammelt.

 

Formulare:

Im Formular frm_Import werden alle Webseiten gelesen und in der Tabelle gespeichert

Dabei besteht das Sammeln und Lesen der Webseiten aus 3 grundlegenden Elementen

1) Startseite öffnen

2) Liste mit Links lesen

3) Details zu jedem neuen Link lesen

Der jeweilige vba Code befindet sich hinter dem Button als OnClick-Event.

 

3 Schritte des Web Roboters

 

1) Startseite öffnen

Unter dem ersten Schritt des Webscraping Vorgangs wird einfach die Startseite geöffnet, wo sich folgend die Listen mit den Links befinden.

Navigieren zur Startseite

browser.Navigate sURL

 

 

Vba Code zum Navigieren der Startseite.

Private Function fx_goto_List() As Boolean

    '------------< fx_goto_List_Page() >------------

    fx_goto_List = False

 

    tbxURL = DLookup("KeyValue", "tbl_KeyData", "[KeyName]='URL'")

 

 

    '< check >

    If Nz(tbxDomain.Value, "") Like "" Then Exit Function

    If Nz(tbxURL.Value, "") Like "" Then Exit Function

    '</ check >

 

 

    '< url >

    Dim sURL As String

    sURL = tbxURL

    '</ url >

   

    '< Startseite >

    Set browser = ctlBrowser.Object

   

    browser.Silent = True

    browser.Navigate sURL

    '</ Startseite >

 

    '< check: webdocument ready >

    If wait_for_Document = False Then

        MsgBox "website not loaded in time", vbCritical, "no Website"

        fx_goto_List = False

        Exit Function

    End If

    '</ check: webdocument ready >

   

    Set hdoc = browser.Document

       

 

   

    fx_goto_List = True

    '------------</ fx_goto_List_Page() >------------

End Function

 

2) URL Links einlesen

Dabei wird erst der Zielbereich erfasst in welchem sich die Links befinden

Set arrElements = vTD.getElementsByClassName("cssListItem_Main_lnkTitle")

 

Anschließend werden alle Links aus einem Listenbereich gelesen

vTD.getElementsByClassName("cssListItem_Main_lnkTitle")

 

Kompletter vba Code zum Lesen der URL Links aus einer Webseite.

Dabei werden in diesem Beispiel der DIV Bereich: ctl00_ctlMenu erfasst und hieraus alle Links mit dem Classname rmLin rmRootLink erfasst in einem Rubrik-Array, welche anschliessend alle durchlaufen werden.

Anschliessend werden alle URL Links im Bereich htmlTD: Main_Content_tdListe  Bereich  erfasst mit getElementsByClassName("cssListItem_Main_lnkTitle") und anschliessend in der Tabelle gespeichert.

 

Private Function fx_Read_List()

    '------------< fx_Read_List() >------------

 

    '< get Menu >

    Dim vDiv As HTMLDivElement

    Set vDiv = hdoc.getElementById("ctl00_ctlMenu")

   

    '< get Menu-Area Links >

    Dim arrAreas As IHTMLElementCollection

    Set arrAreas = vDiv.getElementsByClassName("rmLink rmRootLink")

    '</ get Menu-Area Links >

   

    '< save in Array >

    Dim arrLinks() As String

    ReDim arrLinks(100)

    Dim iLink As Integer

    For iLink = 0 To arrAreas.length - 1

        Dim aLink As HTMLAnchorElement

        Set aLink = arrAreas(iLink)

        arrLinks(iLink) = aLink.hRef

    Next

    ReDim Preserve arrLinks(iLink - 1)

    '</ save in Array >

 

    '--< @Loop: Rows >--

    '--------< @Loop: Menu-Areas >--------

    Dim sLink As Variant

    For Each sLink In arrLinks

        If btnStop = -1 Then Exit For

 

        '< show URL >

        tbxURL = sLink

        browser.Navigate tbxURL

        '</ show URL >

 

        '< wait >

        wait_seconds 3

        wait_for_Document 10

        '</ wait >

        DoEvents

 

        '< check >

        If hdoc Is Nothing Then Exit Function

        '</ check >

 

        '--< Data-Area >--

        Dim vTD As HTMLTableCell

        Set vTD = hdoc.getElementById("Main_Content_tdListe")

        '--< Data-Area >--

       

        Dim bNew As Boolean

 

        '----< get items >----

        Dim arrElements As IHTMLElementCollection

        Set arrElements = vTD.getElementsByClassName("cssListItem_Main_lnkTitle")

        '--< @Loop: Rows >--

        Dim element As HTMLHtmlElement

        For Each element In arrElements

            Dim vLink As HTMLAnchorElement

            Set vLink = element

            '< add >

            bNew = fx_add_Result(vLink.hRef)

            '</ add >

 

            '< check >

            'If bNew = False Then Exit For

            '</ check >

        Next

        '--</ @Loop: Rows >--

        '----</ get items >----

 

        '< eof_new >

        'If bNew = False Then Exit For

        '</ eof_new >

 

    Next

    '--------</ @Loop: Pages >--------

 

    '------------</ fx_Read_List() >------------

End Function

 

3) offene Webseiten lesen

Beim lesen aller neuen URL Links werden diese anschließend aus der Tabelle geladen und der Browser navigiert zum URL Link

 

Dim recDetails As Recordset

Dim sSQL As String

sSQL = "SELECT * FROM tbl_Pages"

sSQL = sSQL & " WHERE [Title] IS NULL"

 

 

Set recDetails = CurrentDb.OpenRecordset(sSQL, dbOpenDynaset)

    Do Until recDetails.EOF

'--------< @Loop: EOF >--------

If btnStop = -1 Then Exit Do

       

        '< url >

Dim sURL As String

sURL = recDetails("URL")

browser.Navigate sURL

 

Anschliessend wird ebenfalls der innerText aus einem Bereich gelesen.

Set hdoc = browser.Document

           

        '--< Title >--

        Dim vSpan As HTMLSpanElement

        Set vSpan = hdoc.getElementById("SubHeader_Content_lblTitle")

        Dim sTitle As String

        sTitle = vSpan.innerText

        '--</ Title >--

       

        '--< Details >--

        Dim vDiv As HTMLDivElement

        Set vDiv = hdoc.getElementById("Main_Content_pnlMain")

        Dim sDetails As String

        sDetails = vDiv.innerText

        '--</ Details >--

 

 

 

Die Datenbank inklusive vba Code wird zum Download zu diesem Beitrag bereitgestellt.

Mobile

.

0123movie.net