Güncel Market Fiyatları İnternetten Bulmak

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,209
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Ben resimleri istersiniz diye bekliyordum :)
Neyseki VBA ile parçaları birleştirip, araba yapılması istenmedi :)

Şaka bir yana, 70 adet ürün için sunucuya 70 defa istek gönderip geri dönen sonucu ayıklamak gerekir. Hem Excel'e yazık olur, hem de bana.....

.
 
Katılım
9 Mart 2023
Mesajlar
11
Excel Vers. ve Dili
v6
Neyseki VBA ile parçaları birleştirip, araba yapılması istenmedi :)

Şaka bir yana, 70 adet ürün için sunucuya 70 defa istek gönderip geri dönen sonucu ayıklamak gerekir. Hem Excel'e yazık olur, hem de bana.....

.
valla hocam uğraştırıyoruz senide ama 1 haftadan fazladır çözüm arıyorum ya 10 dk da çözdük neredeyse
 

beab05

Özel Üye
Katılım
19 Mart 2007
Mesajlar
1,362
Excel Vers. ve Dili
Office 2013
Zaten tüm sayfalar içindeki ürünleri tek seferde almak doğru olmaz. Bunun bir sürü dezavantajı var. Bu sebeple önce sayfalar listelenmeli ve sonra seçilen sayfaya göre kullanıcı istek yapmalı. Ya da ilk sayfa verileri alınır ve diğer sayfa numaraları da da uygun bir yere yazdırılır combobox gibi ve seçilip sorgulanır.

Ya da kullanıcı sayfaları ve linki bir hücreye manuel girsin ve ve öyle aratsın. Bir hücreye linki bir hücreye sayfa numarasını..
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,209
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Ürün açıklamalarına alternatif olarak; A sütunundaki ürün isimlerine link eklenir, kullanıcı tıkladığında o ürüne ait açıklamaların olduğu web sayfasına gider.


Capture.PNG



Bu işinize yararsa, ilgili kod;

C#:
Sub Test6()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:B" & Rows.Count).ClearContents
Range("A1:B1") = Array("Ürün", "Fiyat")

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
        End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,209
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Başka bir alternatif de; A sütunundaki ürün isimlerine link ekledikten sonra, C sütununa otomatik olarak yerleştirilen "Detay" butonlarına tıklandığında D sütunundaki hücreye ürünün açıklamasını getirmektir.

Böylece, sadece istenen ürünlerin açıklamaları alınmış olur ve Excel fazla yorulmaz....


Capture.PNG



Bununla ilgili kodlar;

C#:
Sub Test7()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:C" & Rows.Count).ClearContents
Range("A1:C1") = Array("Ürün", "Fiyat", "Detay")

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
     
            Set btn = ActiveSheet.Buttons.Add(Range("C" & iRow + 1).Left, Range("C" & iRow + 1).Top, Range("C" & iRow + 1).Width, Range("C" & iRow + 1).Height)
            With btn
              .OnAction = "getDetails"
              .Caption = "Detay"
              .Name = "Btn" & iRow
            End With
       End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
'
Sub getDetails()
    i = Replace(Application.Caller, "Btn", "")
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
   
    Set HTML = CreateObject("HTMLFILE")
   
    strURL = Range("A" & i + 1).Hyperlinks(1).Address
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send
   
    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")
   
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-detail" Then
            On Error Resume Next
            Range("D" & i + 1) = Trim(Divs(x).getElementsByTagName("span")(0).innerText)
            On Error GoTo 0
        End If
    Next
End Sub
.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,209
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Ürün resimleriyle ilgili olarak da; istenilen ürüne ait "Detay" butonuna tıklandığında D sütunundaki hücreye ürüne ait açıklamayla birlikte, o hücreye "Comment-Açıklama" eklenir ve hücrenin üzerine mouse ile gelindiğinde "Açıklamanın" içerisinde ürünün resmi görüntülenir.


Untitled.png

Bununla ilgili kodlar da;

C#:
Sub Test8()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:D" & Rows.Count).ClearContents
Range("D1:D" & Rows.Count).ClearComments
ActiveSheet.Buttons.Delete
Range("A1:D1") = Array("Ürün", "Fiyat", "", "Detay")
Range("A1:D1").Font.Bold = True
Columns("A").ColumnWidth = 50
Columns("B:D").ColumnWidth = 9

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
       
            Set btn = ActiveSheet.Buttons.Add(Range("C" & iRow + 1).Left, Range("C" & iRow + 1).Top, Range("C" & iRow + 1).Width, Range("C" & iRow + 1).Height)
            With btn
              .OnAction = "getDetails"
              .Caption = "Detay"
              .Name = "Btn" & iRow
            End With
       End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
'
Private Sub getDetails()
    i = Replace(Application.Caller, "Btn", "")
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    Set HTML = CreateObject("HTMLFILE")
    
    strURL = Range("A" & i + 1).Hyperlinks(1).Address
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    
    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")
    
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-detail" Then
            On Error Resume Next
            Range("D" & i + 1) = Trim(Divs(x).innerText)
            Range("D" & i + 1) = Trim(Divs(x).getElementsByTagName("span")(0).innerText)
            Range("D" & i + 1).WrapText = False
            On Error GoTo 0
        End If
        
        If Divs(x).ID = "product-primary-image" Then
            On Error Resume Next
            Set CommentBox = Range("D" & i + 1).AddComment
            picURL = Replace(Divs(x).getElementsByTagName("img")(0).src, "about:", "https:")
            CommentBox.Shape.Fill.UserPicture (picURL)
            CommentBox.Shape.Width = 100
            CommentBox.Shape.Height = 100
            On Error GoTo 0
        End If
    Next
End Sub
.
 
Son düzenleme:

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,563
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Sayın Haluk Hocam,
Muhteşemsiniz, insanda daha neler yapılabilir? sorusunun canlanmasını tetikliyorsunuz. Excel'de ve GoogleDrive tabanlı işlemlerde sizden de çok şey öğrendiğimi biliyorum ve müteşekkirim. Gerçi henüz, destek olmadan internet tabanlı işlemlerde başarılı olamıyorum ama olsun hep destekleyen excel.web.tr ailesinin yanımda olduğunu biliyorum.
akakce.com da kategorileri listelemek istedim ama başarılı olamadım. Daha nerelere dikkat etmem gerektiğini tam kavrayamamışım demek, ama, öğreneceğim!
Saygılarımla
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,209
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Tevfik Bey, nazik mesajınız için size ve mesajlarda "Beğenisini" ileten herkese teşekkür ederim...

.
 

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,209
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
valla hocam uğraştırıyoruz senide ama 1 haftadan fazladır çözüm arıyorum ya 10 dk da çözdük neredeyse
İcimde kalmasin diye yaziyorum........Biz ugrastik ortaya birseyler cikarttik, ama siz zahmet edip bir cevap bile yazmadiniz.

.
 
Son düzenleme:

ibere

Altın Üye
Katılım
31 Mart 2018
Mesajlar
126
Excel Vers. ve Dili
Office 365
Ürün resimleriyle ilgili olarak da; istenilen ürüne ait "Detay" butonuna tıklandığında D sütunundaki hücreye ürüne ait açıklamayla birlikte, o hücreye "Comment-Açıklama" eklenir ve hücrenin üzerine mouse ile gelindiğinde "Açıklamanın" içerisinde ürünün resmi görüntülenir.


Ekli dosyayı görüntüle 243502

Bununla ilgili kodlar da;

C#:
Sub Test8()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:D" & Rows.Count).ClearContents
Range("D1:D" & Rows.Count).ClearComments
ActiveSheet.Buttons.Delete
Range("A1:D1") = Array("Ürün", "Fiyat", "", "Detay")
Range("A1:D1").Font.Bold = True
Columns("A").ColumnWidth = 50
Columns("B:D").ColumnWidth = 9

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
      
            Set btn = ActiveSheet.Buttons.Add(Range("C" & iRow + 1).Left, Range("C" & iRow + 1).Top, Range("C" & iRow + 1).Width, Range("C" & iRow + 1).Height)
            With btn
              .OnAction = "getDetails"
              .Caption = "Detay"
              .Name = "Btn" & iRow
            End With
       End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
'
Private Sub getDetails()
    i = Replace(Application.Caller, "Btn", "")
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
   
    Set HTML = CreateObject("HTMLFILE")
   
    strURL = Range("A" & i + 1).Hyperlinks(1).Address
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send
   
    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")
   
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-detail" Then
            On Error Resume Next
            Range("D" & i + 1) = Trim(Divs(x).innerText)
            Range("D" & i + 1) = Trim(Divs(x).getElementsByTagName("span")(0).innerText)
            Range("D" & i + 1).WrapText = False
            On Error GoTo 0
        End If
       
        If Divs(x).ID = "product-primary-image" Then
            On Error Resume Next
            Set CommentBox = Range("D" & i + 1).AddComment
            picURL = Replace(Divs(x).getElementsByTagName("img")(0).src, "about:", "https:")
            CommentBox.Shape.Fill.UserPicture (picURL)
            CommentBox.Shape.Width = 100
            CommentBox.Shape.Height = 100
            On Error GoTo 0
        End If
    Next
End Sub
.
Hocam eline sağlık, şu xmlhttp nesnesini öğrenmek istiyorum fakat detaylı bir rehber bulamadım. Yardımcı olursan sevinirim.
 

emsey

Altın Üye
Katılım
18 Mart 2007
Mesajlar
171
Excel Vers. ve Dili
OFFICE 2016
Ürün resimleriyle ilgili olarak da; istenilen ürüne ait "Detay" butonuna tıklandığında D sütunundaki hücreye ürüne ait açıklamayla birlikte, o hücreye "Comment-Açıklama" eklenir ve hücrenin üzerine mouse ile gelindiğinde "Açıklamanın" içerisinde ürünün resmi görüntülenir.


Ekli dosyayı görüntüle 243502

Bununla ilgili kodlar da;

C#:
Sub Test8()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:D" & Rows.Count).ClearContents
Range("D1:D" & Rows.Count).ClearComments
ActiveSheet.Buttons.Delete
Range("A1:D1") = Array("Ürün", "Fiyat", "", "Detay")
Range("A1:D1").Font.Bold = True
Columns("A").ColumnWidth = 50
Columns("B:D").ColumnWidth = 9

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
      
            Set btn = ActiveSheet.Buttons.Add(Range("C" & iRow + 1).Left, Range("C" & iRow + 1).Top, Range("C" & iRow + 1).Width, Range("C" & iRow + 1).Height)
            With btn
              .OnAction = "getDetails"
              .Caption = "Detay"
              .Name = "Btn" & iRow
            End With
       End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
'
Private Sub getDetails()
    i = Replace(Application.Caller, "Btn", "")
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
   
    Set HTML = CreateObject("HTMLFILE")
   
    strURL = Range("A" & i + 1).Hyperlinks(1).Address
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send
   
    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")
   
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-detail" Then
            On Error Resume Next
            Range("D" & i + 1) = Trim(Divs(x).innerText)
            Range("D" & i + 1) = Trim(Divs(x).getElementsByTagName("span")(0).innerText)
            Range("D" & i + 1).WrapText = False
            On Error GoTo 0
        End If
       
        If Divs(x).ID = "product-primary-image" Then
            On Error Resume Next
            Set CommentBox = Range("D" & i + 1).AddComment
            picURL = Replace(Divs(x).getElementsByTagName("img")(0).src, "about:", "https:")
            CommentBox.Shape.Fill.UserPicture (picURL)
            CommentBox.Shape.Width = 100
            CommentBox.Shape.Height = 100
            On Error GoTo 0
        End If
    Next
End Sub
.
Vay arkadaş maşallah ya. Kod anlatılmaz yazılır olduğunu defalarca öğrenmiş olduk. Emeğine yüreğine sağlık üstad.
 
Katılım
9 Mart 2023
Mesajlar
11
Excel Vers. ve Dili
v6
Hocam tekrardan Merhaba yardımınız için teşekkür ederim, detay butonuna tıklamadan olduğu gibi açıklamalarıda getirebilir miyiz?
Başka bir alternatif de; A sütunundaki ürün isimlerine link ekledikten sonra, C sütununa otomatik olarak yerleştirilen "Detay" butonlarına tıklandığında D sütunundaki hücreye ürünün açıklamasını getirmektir.

Böylece, sadece istenen ürünlerin açıklamaları alınmış olur ve Excel fazla yorulmaz....


Ekli dosyayı görüntüle 243501



Bununla ilgili kodlar;

C#:
Sub Test7()
' Haluk - 09/03/2023

Dim objHTTP As Object, strURL As String
Dim HTML As Object, Tables As Object, Table As Object
Dim x As Integer, i As Long, iRow As Long, j As Integer, iCount As Integer

Range("A1:C" & Rows.Count).ClearContents
Range("A1:C1") = Array("Ürün", "Fiyat", "Detay")

Set objHTTP = CreateObject("MSXML2.XMLHTTP")

Set HTML = CreateObject("HTMLFILE")

strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca"

objHTTP.Open "GET", strURL, False
objHTTP.send

HTML.body.innerHTML = objHTTP.responseText

Set Divs = HTML.getElementsByTagName("div")

For x = 0 To Divs.Length - 1
    If Divs(x).classname = ("record-count text-right mt-3 mb-3") Then
        iCount = Split(Divs(x).innerText, " ")(1) \ 30 + 1
    End If
Next

For j = 1 To iCount
    strURL = "https://www.onlineyedekparca.com/kategori/opel-tigra-a-yedek-parca?tp=" & j

    objHTTP.Open "GET", strURL, False
    objHTTP.send

    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")

    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "showcase-title" Then
            iRow = iRow + 1
            Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
            ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & iRow + 1), Address:="https://www.onlineyedekparca.com/" & Replace(Divs(x).getElementsByTagName("a")(0).href, "about:/", "")
    
            Set btn = ActiveSheet.Buttons.Add(Range("C" & iRow + 1).Left, Range("C" & iRow + 1).Top, Range("C" & iRow + 1).Width, Range("C" & iRow + 1).Height)
            With btn
              .OnAction = "getDetails"
              .Caption = "Detay"
              .Name = "Btn" & iRow
            End With
       End If
        If Divs(x).classname = "showcase-price" Then
            Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
            Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
        End If
    Next
Next
End Sub
'
Sub getDetails()
    i = Replace(Application.Caller, "Btn", "")
  
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
  
    Set HTML = CreateObject("HTMLFILE")
  
    strURL = Range("A" & i + 1).Hyperlinks(1).Address
  
    objHTTP.Open "GET", strURL, False
    objHTTP.send
  
    HTML.body.innerHTML = objHTTP.responseText

    Set Divs = HTML.getElementsByTagName("div")
  
    For x = 0 To Divs.Length - 1
        If Divs(x).classname = "product-detail" Then
            On Error Resume Next
            Range("D" & i + 1) = Trim(Divs(x).getElementsByTagName("span")(0).innerText)
            On Error GoTo 0
        End If
    Next
End Sub
.
 
Üst