Registriert seit: 02.08.2014
Version(en): 2016
Hallo,
ich glaube, ihr solltet besser die Methode GetElementsByTagName verwenden.
Meine HMTL-Kenntnisse sind rudimentär, doch span ist ein Tag und kein Name.
Rückgabewert ist bei beiden Methoden eine Collection.
Grüße, Ulrich
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo Florian,
mir fällt nichts mehr dazu ein außer mit einer sicherlich nicht optimalen Fehlerbehandlung (außer Du vergleichst den Hypertext)
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
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
Set html = CreateObject("htmlfile")
For i = 2 To lastRow
url = "https://www.google.co.in/search?q=" & Cells(i, 1) & " " & Cells(i, 2) & " " & "Telefonnummer"
XMLHTTP.Open "GET", url, False
XMLHTTP.setRequestHeader "Content-Type", "text/xml"
XMLHTTP.send
html.body.innerHTML = XMLHTTP.ResponseText
Set objResult = html.getElementByid("rso")
On Error Resume Next
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
On Error GoTo 0
DoEvents
Next i
End Sub
Gruß Stefan
Win 10 / Office 2016
Registriert seit: 02.08.2014
Version(en): 2016
27.04.2018, 11:42
(Dieser Beitrag wurde zuletzt bearbeitet: 27.04.2018, 12:19 von losgehts.)
Hallo,
es geht doch um Fehler 92 (Objectvariable nicht festgelegt). Ich tippe darauf, dass die Variable objResult nothing ist.
Statt der OnError Resume Next Anweisung würde ich daher eine If-Abfrage formulieren:
Code: if not objResult is nothing then
....
else
debug.print html.body.innerHTML ' zum analysieren warum objResult nothing ist
end if
Grüße, Ulrich
[edit: Tippfehler: ich meine Fehler 91]
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo Ulrich,
Florian schreibt in diesem Thread aber immer vom Fehler 91.
Gruß Stefan
Win 10 / Office 2016
Registriert seit: 16.03.2018
Version(en): 2007,2016
Hi nochmal,
Also das wusste Ich nicht das span kein Name sondern ein TagName ist.
Danke dafür schon mal Ich versuch mal mein Glück und melde mich wieder.
Lg Flo
Live is a Game Play it
Registriert seit: 02.08.2014
Version(en): 2016
Hallo,
ich meinte auch Fehler 91, das war ein Tippfehler.
So ganz ohne Grund schreibe ich das ja auch nicht. Wenn ich den Code, den Steffl heute um 12.09 gepostet hat, teste dann erhalte ich ebenfalls die Fehlermeldung 91. Bei mir wehrt sich Google gegen die Abfrage und ich bekomme nicht die Seite ausgegeben, sondern eine Fehlermeldung als html-Seite ausgeliefert: Code: <A href="about://www.google.com/"><SPAN aria-label=Google id=logo></SPAN></A>
<P><B>403.</B> <INS>That’s an error.</INS>
<P>Your client does not have permission to get URL <CODE>/search?q=Sebastian%20Kasperski%20Telefonnummer</CODE> from this server. (Client IP address: **.**.**.**)<BR><BR>Please see Google's Terms of Service posted at http://www.google.com/terms_of_service.html <BR><BR>
<P>If you believe that you have received this response in error, please <A href="https://www.google.com/support/contact/user?hl=en">report</A> your problem. However, please make sure to take a look at our Terms of Service (http://www.google.com/terms_of_service.html).
[...]
Der obige HTML-Quelltext hat zur Folge, dass es kein Tag mit der ID "rso" gibt und damit die Methode getElementByid("rso") nothing zurückgibt.
Welche Suchbegriffe Florian an Google übermittelt und was er wiederum von Google geliefert bekommt, weiß ich (abgesehen von dem angehängten Bild) nicht.
Grüße, Ulrich
Registriert seit: 16.03.2018
Version(en): 2007,2016
Hallo,
Ja genau das ist auch das Problem bei mir
Also was Ich genau von Google will ist = A utohaus Bumann GmbH Rostocker Str. 5 Telefonnummer
Also Firmen die Ich überprüfen will in Excel ob die Tel da ist wenn nicht dann aus Google Kopieren
In dem Bild wird die Tel angezeigt wo Sie in dem HTML code steht.
Lg Flo
Ps. Ich habe meine Cousine mal gefragt sie Ist Webpage Designerin mal schauen was Sie sagt
Live is a Game Play it
Registriert seit: 16.03.2018
Version(en): 2007,2016
Also meine Cousine hat mir geschrieben und eine Lösung gegeben doch geht diese auch nicht
Hier mal Ihr weg vielleicht fällt jemanden auf das hier dann noch was ein
Private Sub xmlHTMLTel()
'Überprüft alle Neuen Firmen ob die Tel eingetragen wurde
Dim url As String, lastRow As Long
Dim XMLHTTP As Object, html As Object, objResultDiv As Object, phone As Object, links As Object
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" & 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 links = html.getelementsbytagname("fl")
Set phone = links(0).getAttribute("data-number") 'Hier ist der Fehler
str_text = Replace(links.innerHTML, " ", "")
str_text = Replace(str_text, "", "")
Cells(i, 7) = phone
DoEvents
Next
End Sub
Live is a Game Play it
Registriert seit: 02.08.2014
Version(en): 2016
Hallo,
sehr cool, dass deine Cousine weiß, wie man den Useragentstring anpassen kann.
Dieser Code funktioniert bei mir mit dem Suchbegriff
Autohaus Bumann GmbH Rostocker Str. 5 Telefonnummer
Code: Private Sub xmlHTMLTel_test()
'Überprüft alle Neuen Firmen ob die Tel eingetragen wurde
Dim url As String, lastRow As Long, i As Long
Dim XMLHTTP As Object, html As Object
Dim str_text As String
Const strVorNr As String = "<DIV class=Z0LcW><SPAN data-local-attribute=""d3ph"" data-dtype=""d3ifr""><SPAN>"
Const strNachNr As String = "</SPAN>"
lastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
url = "https://www.google.co.in/search?q=" & URLEncode(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
str_text = Mid(html.body.innerhtml, InStr(html.body.innerhtml, strVorNr) + Len(strVorNr))
If InStr(str_text, strNachNr) > 0 Then 'nur um Fehler abzufangen
str_text = Mid(str_text, 1, InStr(str_text, strNachNr) - 1)
End If
' Debug.Print str_text
Cells(i, 7) = Trim(str_text)
DoEvents ' Wozu?
Next
End Sub
Public Function URLEncode(strInput As String, Optional bBlankAsPlus As Boolean = False) As String
'Quelle: EtoPHG http://www.office-loesung.de/ftopic486146_0_0_asc.php
Dim lLen As Long: lLen = Len(strInput)
If lLen > 0 Then
ReDim strOutput(lLen) As String
Dim lX As Long, iCode As Integer
Dim strChar As String, strBlank As String
If bBlankAsPlus Then strBlank = "+" Else strBlank = "%20"
For lX = 1 To lLen
strChar = Mid(strInput, lX, 1)
iCode = Asc(strChar)
Select Case iCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
strOutput(lX) = strChar
Case 32
strOutput(lX) = strBlank
Case 0 To 15
strOutput(lX) = "%0" & Hex(iCode)
Case Else
strOutput(lX) = "%" & Hex(iCode)
End Select
Next lX
URLEncode = Join(strOutput, "")
End If
End Function
Grüße, Ulrich
Folgende(r) 1 Nutzer sagt Danke an losgehts für diesen Beitrag:1 Nutzer sagt Danke an losgehts für diesen Beitrag 28
• Florian20
Registriert seit: 16.03.2018
Version(en): 2007,2016
Hallo und Guten Morgen,
Ich Danke euch allen es funktioniert jetzt Perfekt.
Lg Flo
Live is a Game Play it
|