bu kod çalışmıyor acaba nerde yanlışlık olmuş olabilir

[İBRAHİMTNÇ]

ÖRNEK LİNK A4 SÜTÜNUNA EKLENİR

https://www.trendyol.com/bingo/fresh-yuzey-temizleyici-masal-2-5-l-p-39566974?merchantId=243124

ÇALIŞMAYAN YERLER KODLARIN YANINA AŞAĞIDA YAZILI
Sub Sayfa1()
Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLtable As MSHTML.IHTMLElement
Dim HTMLrow As MSHTML.IHTMLElement
Dim HTMLcol As MSHTML.IHTMLElement
Dim linkSaticisi As MSHTML.IHTMLElement
Dim urunAdi As MSHTML.IHTMLElement
Dim linkGuncelF As MSHTML.IHTMLElement
Dim linkEskiF As MSHTML.IHTMLElement
Dim digerSaticilar As MSHTML.IHTMLElement
Dim digerSaticilarP As MSHTML.IHTMLElement
Dim digerSaticilarF As MSHTML.IHTMLElement
Dim digerSaticilarEskiF As MSHTML.IHTMLElement

Dim row As Integer
Dim col As Integer
Dim sonsat As Integer
Dim url As String
Dim i As Integer
Dim i2 As Integer
Dim c As Integer
Dim rng1 As Range

sonsat = Sheets("Sayfa1").Range("A10000").End(xlUp).row
Sheets("Sayfa1").Range("B4:Y" & 10000).ClearContents
Sheets("Sayfa1").Range("AB4:AC" & 10000).ClearContents

For i = 4 To sonsat

url = Sheets("Sayfa1").Range("A" & i)

XMLReq.Open "GET", url, False
XMLReq.setRequestHeader "cf-cache-status", "DYNAMIC"
XMLReq.setRequestHeader "content-type", "txt/html"
XMLReq.setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/94.0.4606.81 Safari/537.36"
XMLReq.send allbody

If XMLReq.Status <> 200 Then

Sheets("Sayfa1").Range("B" & i) = "Sayfaya ulaşılamadı!"
GoTo cikiss

End If

HTMLDoc.body.innerHTML = XMLReq.responseText

On Error Resume Next
Set linkSaticisi = HTMLDoc.getElementsByClassName("merchant-text")(0)
Set urunAdi = HTMLDoc.getElementsByTagName("h1")(0)
Set linkEskiF = HTMLDoc.getElementsByClassName("product-price-container")(0).getElementsByClassName("prc-org")(0) 'ÇALIŞMIYOR
Set linkGuncelF = HTMLDoc.getElementsByClassName("product-price-container")(0).getElementsByClassName("prc-slg")(0)'ÇALIŞMIYOR
Set linkSaticiP = HTMLDoc.getElementsByClassName("sl-pn")(0)

Sheets("Sayfa1").Range("C" & i) = linkSaticisi.innerText
Sheets("Sayfa1").Range("B" & i) = urunAdi.innerText
Sheets("Sayfa1").Range("E" & i) = CDbl(FormatNumber(Replace(linkEskiF.innerText, "TL", ""), 2))
Sheets("Sayfa1").Range("D" & i) = CDbl(FormatNumber(Replace(linkGuncelF.innerText, "TL", ""), 2))

c = 6

For i2 = 1 To 4

Set digerSaticilar = HTMLDoc.getElementsByClassName("omc-cntr")(0).getElementsByClassName("pr-mc-w")(i2 - 1).getElementsByClassName("mc-ct-lft")(0).getElementsByTagName("a")(0) 'ÇALIŞMIYOR
Set digerSaticilarP = HTMLDoc.getElementsByClassName("omc-cntr")(0).getElementsByClassName("pr-mc-w")(i2 - 1).getElementsByClassName("sl-pn")(0)'ÇALIŞMIYOR
Set digerSaticilarF = HTMLDoc.getElementsByClassName("omc-cntr")(0).getElementsByClassName("pr-mc-w")(i2 - 1).getElementsByClassName("prc-slg")(0)'ÇALIŞMIYOR
Set digerSaticilarEskiF = HTMLDoc.getElementsByClassName("pr-omc")(0).getElementsByClassName("pr-mc-w")(i2 - 1).getElementsByClassName("prc-org")(0)'ÇALIŞMIYOR

Sheets("Sayfa1").Cells(i, c) = digerSaticilar.innerText
Sheets("Sayfa1").Cells(i, c + 1) = CDbl(FormatNumber(Replace(digerSaticilarF.innerText, "TL", ""), 2))
Sheets("Sayfa1").Cells(i, c + 2) = CDbl(FormatNumber(Replace(digerSaticilarEskiF.innerText, "TL", ""), 2))
Sheets("Sayfa1").Cells(i, c + 3) = digerSaticilarP.innerText

Set digerSaticilar = Nothing
Set digerSaticilarP = Nothing
Set digerSaticilarF = Nothing
Set digerSaticilarEskiF = Nothing

c = c + 4
Next

Sheets("Sayfa1").Range("W" & i) = WorksheetFunction.Min(Sheets("Sayfa1").Range("D" & i), Sheets("Sayfa1").Range("G" & i), Sheets("Sayfa1").Range("K" & i), Sheets("Sayfa1").Range("O" & i), Sheets("Sayfa1").Range("S" & i))
arananK = Sheets("Sayfa1").Range("D" & i & ":" & "S" & i).Find(Sheets("Sayfa1").Range("W" & i)).Column
Sheets("Sayfa1").Range("V" & i) = Sheets("Sayfa1").Cells(i, arananK - 1)
Sheets("Sayfa1").Range("X" & i) = Sheets("Sayfa1").Cells(i, arananK + 1)

If WorksheetFunction.CountA(Sheets("Sayfa1").Range("D" & i), Sheets("Sayfa1").Range("G" & i), Sheets("Sayfa1").Range("K" & i), Sheets("Sayfa1").Range("O" & i), Sheets("Sayfa1").Range("S" & i)) = 1 Then

Sheets("Sayfa1").Range("Y" & i) = "Başka Satıcı Yok"

GoTo cikis

End If

If Sheets("Sayfa1").Range("W" & i) < Sheets("Sayfa1").Range("D" & i) Then

Sheets("Sayfa1").Range("Y" & i) = "Daha Uygun Fiyat Var!"

ElseIf Sheets("Sayfa1").Range("W" & i) = Sheets("Sayfa1").Range("D" & i) Then

Sheets("Sayfa1").Range("Y" & i) = "En Uygun Fiyattasın "

End If

cikis:

If Sheets("Sayfa1").Range("Y" & i) = "Daha Uygun Fiyat Var!" Then

If Sheets("Sayfa1").Range("W" & i) - Sheets("Sayfa1").Range("AA" & i) > Sheets("Sayfa1").Range("Z" & i) Then

Sheets("Sayfa1").Range("AB" & i) = "Evet"
Sheets("Sayfa1").Range("AC" & i) = Sheets("Sayfa1").Range("W" & i) - Sheets("Sayfa1").Range("AA" & i)

Else:

Sheets("Sayfa1").Range("AB" & i) = "Hayır"

End If

Else:

Sheets("Sayfa1").Range("AB" & i) = "Gerek Yok"

End If

cikiss:

Next
End Sub

 

[İBRAHİMTNÇ]

REFERANSLAR MİCROSOFT XML, V6.0
MİCROSOFT SCRİPTİNG RUNTİME
MİCROSOFT HTML OBJECT LİBRARY

 

[netzone]

Merhaba,
VBA kodlarında hata nerededir bilmiyorum arkadaşlarımız gözden geçirip size yardımcı olurlar diye düşünüyorum.

HTML kodlarını incelediğimde;

Set linkEskiF = HTMLDoc.getElementsByClassName("product-price-container")(0).getElementsByClassName("prc-org")(0) 'ÇALIŞMIYOR
Set linkGuncelF = HTMLDoc.getElementsByClassName("product-price-container")(0).getElementsByClassName("prc-slg")(0)'ÇALIŞMIYOR

Yerine

Set linkEskiF = HTMLDoc.getElementsByClassName("pr-bx-nm with-org-prc")(0).getElementsByClassName("prc-org")(0) 'ÇALIŞMIYOR
Set linkGuncelF = HTMLDoc.getElementsByClassName("pr-bx-nm with-org-prc")(0).getElementsByClassName("prc-slg")(0)'ÇALIŞMIYOR

Sorunu çözebilir gibi algıladım.

Set digerSaticilar = HTMLDoc.getElementsByClassName("omc-cntr")(0).getElementsByClassName("pr-mc-w")(i2 - 1).getElementsByClassName("mc-ct-lft")(0).getElementsByTagName("a")(0) 'ÇALIŞMIYOR
Set digerSaticilarP = HTMLDoc.getElementsByClassName("omc-cntr")(0).getElementsByClassName("pr-mc-w")(i2 - 1).getElementsByClassName("sl-pn")(0)'ÇALIŞMIYOR
Set digerSaticilarF = HTMLDoc.getElementsByClassName("omc-cntr")(0).getElementsByClassName("pr-mc-w")(i2 - 1).getElementsByClassName("prc-slg")(0)'ÇALIŞMIYOR
Set digerSaticilarEskiF = HTMLDoc.getElementsByClassName("pr-omc")(0).getElementsByClassName("pr-mc-w")(i2 - 1).getElementsByClassName("prc-org")(0)'ÇALIŞMIYOR

Burada yer alan (Kırmızı boyalı) sınıflar ise HTML kodlarına baktığımızda olmadığı görünüyor. Bu nedenle hata veriyor olabilir.

İyi çalışmalar.

 

[İBRAHİMTNÇ]

Set linkEskiF = HTMLDoc.getElementsByClassName("pr-bx-nm with-org-prc")(0).getElementsByClassName("prc-org")(0) 'ÇALIŞMIYOR
Set linkGuncelF = HTMLDoc.getElementsByClassName("pr-bx-nm with-org-prc")(0).getElementsByClassName("prc-slg")(0)'ÇALIŞMIYOR

hocam ilginize çok teşekkür ediyorum ama çalışmadı acaba iki tane class yanyana geldiğinde excel kabul etmiyor mu veya bunu döngü içine mi yazmak lazım for each gibi yardımcı olursanız sevinirim

 

[İBRAHİMTNÇ]

Konu hala güncel ve çözülmedi

 

[ptcsite]

hocam ilginize çok teşekkür ediyorum ama çalışmadı acaba iki tane class yanyana geldiğinde excel kabul etmiyor mu veya bunu döngü içine mi yazmak lazım for each gibi yardımcı olursanız sevinirim

Arkadaşım 2 class yanyana gelmez. ilkini İDsini bul o alanın onu yaz ve ardından tag ile bitir tagda değilse classta olabilir...