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