Clever-Excel-Forum

Seiten: 1 2

Guten Morgen Leute,

Ich habe mal wieder ein Problem, Ich möchte gerne eine Google abfrage starten, nur klappt es nicht so wie Ich will.
Hier meine Vorstellung:

Der Code soll Google öffnen eine suche starten und die Telefonnummer Kopieren.
Mit dem "Body Text" & "Url" klapp das auch gut nur nicht mit der Tel?

Hier mein Code (ein Teil davon):

        url = "https://www.google.co.in/search?q=" & Cells(i, 1) & Cells(i, 2) & "&Telefonnummer=" & WorksheetFunction.RandBetween(1, 10000)
        Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
        XMLHTTP.Open "GET", url, False
        XMLHTTP.setRequestHeader "Content-Type", "text/xml"
        XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
        XMLHTTP.send

        Set html = CreateObject("htmlfile")
        html.body.innerHTML = XMLHTTP.ResponseText
        Set objResultDiv = html.getelementbyid("rhs_block")
        Set objH3 = objResultDiv.getelementsbytagname("span")(0)
        Set Tel = objH3.getelementsbytagname("span")(0)   'Hier wird die Telefonnummer aus dem HTML gelesen

        str_text = Replace(Tel.innerHTML, "", "")    'Hier ist der Fehler! (Laufzeitfehler '91':)
        str_text = Replace(str_text, "", "")
        Cells(i, 7) = str_text
        Cells(i, 8) = Tel.href

Ich hoffe Ihr könnt mir helfen
Lg Flo

Hallo,

Zitat:Hier mein Code (ein Teil davon):

das ist ja fein, daß Du uns die Codezeile zeigst, in der der Code aussteigt.
Der Fehler liegt aber wahrscheinlich woanders und wirkt sich erst hier aus.

Mit anderen Worten: In Fragmenten suche ich nicht nach Fehlern.

Okay hier der ganze Code:

Code:
Sub XMLHTTP()

    Dim url As String, lastRow As Long

    Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, Tel As Object

    Dim i As Integer

    Dim str_text As String

    lastRow = Range("A" & Rows.Count).End(xlUp).Row

    Dim cookie As String

    Dim result_cookie As String

    For i = 2 To lastRow

        url = "[url=https://www.google.co.in/search?q]https://www.google.co.in/search?q[/url]=" & Cells(i, 1) & "&Telefonnummer=" & WorksheetFunction.RandBetween(1, 10000)

        Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")

        XMLHTTP.Open "GET", url, False

        XMLHTTP.setRequestHeader "Content-Type", "text/xml"

        XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"

        XMLHTTP.send

        Set html = CreateObject("htmlfile")

        html.body.innerHTML = XMLHTTP.ResponseText

        Set objResultDiv = html.getElementByid("rhs_block")

        Set objH3 = objResultDiv.getElementsByTagName("span")(1)

        Set Tel = objH3.getElementsByTagName("span")

        str_text = Replace(Tel.innerHTML, "<EM>", "")

        str_text = Replace(str_text, "</EM>", "")

        Cells(i, 7) = str_text

        Cells(i, 8) = Tel.href

        DoEvents

    Next

MsgBox "Alle Firmen wurden in Google geprüft!" & vbLf & _

       "Die Firmen ohne Tel und Web wurden aktualiesiert!", vbInformation, "Google Suche!"

End Sub

Guten Morgen,

Ich habe den Code Nochmal umgebaut aber es geht immer noch nicht :@
Der Code sucht eine Telefonnummer aus Google und dann Laufzeitfehler"91"

Aber Ich weiß nicht warum ??

Hier der Andere Code:

Private Sub XMLTEL()
'Überprüft alle Neuen Firmen ob die Tel eingetragen wurde
Dim url As String, lastRow As Long
Dim XMLHTTP As Object, html As Object, objResult As Object, objrso As Object, Tel As Object
Dim i, str_text
lastRow = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow
        url = "https://www.google.co.in/search?q=" & Cells(i, 1) & " " & Cells(i, 2) & " " & "Telefonnummer"
        Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
        XMLHTTP.Open "GET", url, False
        XMLHTTP.setRequestHeader "Content-Type", "text/xml"
        XMLHTTP.send

        Set html = CreateObject("htmlfile")
        html.body.innerhtml = XMLHTTP.ResponseText
        Set objResult = html.getElementByID("rso")
        Set objrso = objResult.getElementsByName("span")(0)   'Hier ist der Fehler!
        Set Tel = objrso.getElementsByName("span")(0)

        str_text = Replace(Tel.innerhtml, " ", "")
        Cells(i, 7) = "+49 " & str_text
    DoEvents
    Next i
End Sub

Hoffe nun kann mir jemand helfen
Grüße Flo

Hallo Florian,

schwierig zu sagen. Vermutlich wird dir da kein Array zurückgegeben.

Hallo Stefan,

Das dachte Ich mir auch schon aber in zelle "G3" also der erste durchlauf wird die Tel kopiert.
Erst beim 2 lauf kommt der Fehler. Huh

Hallo Florian,

was meinst Du mit

Zitat:beim 2 lauf kommt der Fehler

Startest Du das Makro zweimal? Oder kommt der Fehler in der Zeile 3, weil die For-Schleife beginnt ja in Zeile 2? Und wenn es das zutrifft, was Unterscheidet sich bei der Internetseite bei den Einträgen?

Hi nochmal,

Ja genau wenn die For schleife anfängt. Dann kommt der Fehler in der Zeile beim öffnen vom ("span") Dialog.
Das Ist dann die Telefonnummer und soweit Ich weiß gibt es keinen unterschied da Google geöffnet wird.

Und Google sollte doch immer gleich sein oder?

Ps. wenn die For schleife 1 mal läuft dann geht es beim 2 mal hängt es ???

Hallo Florian,

was ist eigentlich getElementsByName? Und versuche es mal so (ist aber ungetestet)

Code:
Private Sub XMLTEL()

'Überprüft alle Neuen Firmen ob die Tel eingetragen wurde

Dim url As String, lastRow As Long

Dim XMLHTTP As Object, html As Object, objResult As Object, objrso As Object, Tel As Object

Dim i, str_text

lastRow = Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To lastRow

        url = "https://www.google.co.in/search?q=" & Cells(i, 1) & " " & Cells(i, 2) & " " & "Telefonnummer"

        Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")

        XMLHTTP.Open "GET", url, False

        XMLHTTP.setRequestHeader "Content-Type", "text/xml"

        XMLHTTP.send

        Set html = CreateObject("htmlfile")

        html.body.innerhtml = XMLHTTP.ResponseText

        Set objResult = html.getElementByID("rso")

        If IsArray(objResult.getElementsByName("span")) Then

            Set objrso = objResult.getElementsByName("span")(0)   'Hier ist der Fehler!

            Set Tel = objrso.getElementsByName("span")(0)

        Else

            Set objrso = objResult.getElementsByName("span")   'Hier ist der Fehler!

            Set Tel = objrso.getElementsByName("span")

        End If

        str_text = Replace(Tel.innerhtml, " ", "")

        Cells(i, 7) = "+49 " & str_text

    DoEvents

    Next i

End Sub

Also Ich habe so getestet es geht auch so nicht. Huh

das getElementByTagName oder getElementsByName usw. ist aus der HTML Programmiersprache Blush

Hier ein Bild von Google die gelben Sachen ruft das getElement auf.
Die (0) Steht für den Wert also welchen Wert getElement suchen soll.
In der Zeile ("span") währe (0) = ("span") Blush

Lg Flo

Seiten: 1 2

Florian20

Käpt'n Blaubär

Florian20

Florian20

Steffl

Florian20

Steffl

Florian20

Steffl

Florian20