2016-06-11 32 views
0

Ich muss den Quellcode von mehreren hundert Websites in eine Excel-Datei (zum Beispiel zu Zellen (1, 1) in Arbeitsblättern 1) und dann herunterladen extrahieren Sie den Inhalt der Schlüsselwörter des META-Tags, sagen wir Zellen (1, 2).Wie man META-Schlüsselwörter Inhalt mit VBA aus Quellcode in einer EXCEL-Datei

Zum Herunterladen ich den folgenden Code in VBA verwenden:

Dim htm As Object 
Set htm = CreateObject("HTMLfile") 
URL = "https://www.insolvenzbekanntmachungen.de/cgi-bin/bl_aufruf.pl?PHPSESSID=8ecbeb942c887974468b9010531fc7ab&datei=gerichte/nw/agkoeln/16/0071_IN00181_16/2016_06_10__11_53_26_Anordnung_Sicherungsmassnahmen.htm" 
With CreateObject("MSXML2.XMLHTTP") 
    .Open "GET", URL, False 
    .send 
    htm.body.innerHTML = .responseText 
    Cells(1, 1) = .responseText 
End With 

ich den folgenden Code auf dieser Website gefunden habe, aber leider bin ich nicht in der Lage, es zu adaptieren, mein Problem zu lösen:

Sub GetData() 
Dim ie As New InternetExplorer 
Dim str As String 
Dim wk As Worksheet 
Dim webpage As New HTMLDocument 
Dim item As HTMLHtmlElement 

Set wk = Worksheets(1) 
str = "https://www.insolvenzbekanntmachungen.de/cgi-bin/bl_aufruf.pl?PHPSESSID=8ecbeb942c887974468b9010531fc7ab&datei=gerichte/nw/agkoeln/16/0071_IN00181_16/2016_06_10__11_53_26_Anordnung_Sicherungsmassnahmen.htm" 
ie.Visible = True 

ie.navigate str 

Do 
    DoEvents 
Loop Until ie.readyState = READYSTATE_COMPLETE 


'Find the proper meta element -------------- 
Const META_TAG As String = "META" 
Const META_NAME As String = "keywords" 
Dim Doc As HTMLDocument 
Dim metaElements As Object 
Dim element As Object 
Dim kwd As String 


Set Doc = ie.Document 
Set metaElements = Doc.all.tags(META_TAG) 

For Each element In metaElements 
    If element.Name = META_NAME Then 
     kwd = element.Content 
    End If 
Next 

MsgBox kwd 

End Sub

ich glaube, ich diese Zeile ändern, aber nicht wissen, wie:

Set Doc = ie.Document 

Können Sie mir bitte helfen?

+1

Warum denken Sie "ich muss diese Zeile ändern"? Welche Nachrichten erhalten Sie zurück, wenn Sie Ihre msgbox innerhalb Ihrer Schleife nach "kwd =" verschieben – dbmitch

+0

Tut mir leid für mein schlechtes Englisch. Ich fürchte, ich habe mich nicht richtig ausgedrückt. Der Code, den ich gepostet habe und den ich auf dieser Seite gefunden habe, funktioniert einwandfrei. Leider möchte ich keine Website und extrahiere die META-Tags von der Website selbst, sondern aus dem Quellcode der Website, die ich in Zellen (1, 1) in ein Excel-Arbeitsblatt kopiert habe. Deshalb dachte ich, dass ich die Codezeile ändern muss. Ich möchte mich nicht auf ie.document beziehen, sondern auf Zellen (1, 1). – mpb

Antwort

0

einbetten WebrowserControl in eine Excel-Tabelle oder Userform
How to add a Webrowser to Excel
Verweise auf die HTML-Objektbibliothek einrichten
How to add VBA References – Internet Controls, HTML Object Library

Schnappen Greg Truby Code von diesem Posten Webbroswer Control

Sie müssen Greifen Sie auf das Document Object Model (DOM) zu. Dies wird die meisten der HTMLElements Eigenschaften und Veranstaltung

Option Explicit 

Private WithEvents htmDocument As HTMLDocument 
Private WithEvents MyButton As HTMLButtonElement 

Private Function MyButton_onclick() As Boolean 
    MsgBox "Sombody Click MyButton on WebBrowser1" 
End Function 

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant) 
    Dim aTags As Hyperlinks 

    Do Until .ReadyState = READYSTATE_COMPLETE 
     DoEvents 
    Loop 

    Set MyButton = htmDocument.getElementById("MyButtonID") 
    Set htmDocument = WebBrowser1.Document 
    Set aTags = htmDocument.getElementsByTagName("a") 
End Sub 

Google Web Api, HTA, (MDN) {} https://developer.mozilla.org/en-US/docs/Web/API aussetzen und wenn Sie nicht weiterkommen versuchen Javascript-Code Refactoring VBScript. Es ist