Soru Web Sorgu-Runtime Error 438 Hatası

[hasankardas]

Merhabalar,
Chatgpt ile bir sorgulama yapmak istedim fakat hata almaktayım. Runtime errror-438 hatası. A2 hücresine yazdığım şirketin, b2 ye yazılan yerde, yasal ünvanı-telefon numarası ve adresinin sorgusunu yapmak istiyorum..

Sub SearchCompanyAndWriteDetails()
    Dim xml As Object
    Dim html As Object
    Dim companyName As String
    Dim searchAddress As String
    Dim searchUrl As String
    Dim resultItems As Object
    Dim firstResult As Object
    Dim companyTitle As String
    Dim companyAddress As String
    Dim companyPhone As String

    ' A2 hücresindeki firmayı ve B2 hücresindeki adresi oku
    companyName = ThisWorkbook.Sheets(2).Range("A2").Value
    searchAddress = ThisWorkbook.Sheets(2).Range("B2").Value

    ' MSXML2.XMLHTTP nesnesini oluştur
    Set xml = CreateObject("MSXML2.XMLHTTP")
    Set html = CreateObject("htmlfile")

    ' Arama URL'sini oluştur
    searchUrl = "https://www.bulurum.com/Search/?query=" & companyName & "&region=" & searchAddress

    ' URL'ye GET isteği gönder
    xml.Open "GET", searchUrl, False
    xml.setRequestHeader "Content-Type", "text/html"
    xml.send

    ' Sayfa içeriğini al
    html.body.innerHTML = xml.responseText

    ' Sonuçları içeren öğeleri bul
    Set resultItems = html.getElementsByClassName("search-result-item")

    ' İlk sonucu yazdır
    If resultItems.Length > 0 Then
        Set firstResult = resultItems(0)

        ' Firma ünvanı
        On Error Resume Next
        companyTitle = firstResult.getElementsByClassName("result-title")(0).innerText
        On Error GoTo 0

        ' Firma adresi
        On Error Resume Next
        companyAddress = firstResult.getElementsByClassName("address")(0).innerText
        On Error GoTo 0

        ' Firma telefonu
        On Error Resume Next
        companyPhone = firstResult.getElementsByClassName("phone")(0).innerText
        On Error GoTo 0

        ' Sonuçları hücrelere yaz
        ThisWorkbook.Sheets(2).Range("C2").Value = companyTitle
        ThisWorkbook.Sheets(2).Range("D2").Value = companyPhone
        ThisWorkbook.Sheets(2).Range("E2").Value = companyAddress
    Else
        ThisWorkbook.Sheets(2).Range("C2").Value = "Sonuç bulunamadı."
        ThisWorkbook.Sheets(2).Range("D2").Value = "Sonuç bulunamadı."
        ThisWorkbook.Sheets(2).Range("E2").Value = "Sonuç bulunamadı."
    End If

    ' Temizlik
    Set xml = Nothing
    Set html = Nothing
End Sub

İndir arama

Dosyayı indir arama

dosya.co

Yardımlarınız için teşekkür ederim.

 

[hasankardas]

yardımcı olabilir misiniz*