• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Güncel Market Fiyatları İnternetten Bulmak

  • Konbuyu başlatan Konbuyu başlatan 5353
  • Başlangıç tarihi Başlangıç tarihi
beab05' Alıntı:
Ben resimleri istersiniz diye bekliyordum :)
Genişletmek için tıkla ...

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.....

.
 
Haluk' Alıntı:
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.....

.
Genişletmek için tıkla ...
valla hocam uğraştırıyoruz senide ama 1 haftadan fazladır çözüm arıyorum ya 10 dk da çözdük neredeyse
 
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ı..
 
Ü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

.
 
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

.
 
Ü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:
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
 
Tevfik Bey, nazik mesajınız için size ve mesajlarda "Beğenisini" ileten herkese teşekkür ederim...

.
 
serkagkx' Alıntı:
valla hocam uğraştırıyoruz senide ama 1 haftadan fazladır çözüm arıyorum ya 10 dk da çözdük neredeyse
Genişletmek için tıkla ...

İcimde kalmasin diye yaziyorum........Biz ugrastik ortaya birseyler cikarttik, ama siz zahmet edip bir cevap bile yazmadiniz.

.
 
Son düzenleme:
Haluk' Alıntı:
Ü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

.
Genişletmek için tıkla ...

Hocam eline sağlık, şu xmlhttp nesnesini öğrenmek istiyorum fakat detaylı bir rehber bulamadım. Yardımcı olursan sevinirim.
 
Haluk' Alıntı:
Ü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

.
Genişletmek için tıkla ...
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.
 
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?
Haluk' Alıntı:
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

.
Genişletmek için tıkla ...
 
Merhaba iyi çalışmalar arkadaşlar bu siteden ürün ismi ve fiyatı çekebiliyoruz ama barkod çekemedim yardımcı olursanız çok sevinirim çok makbule geçicek eğer barkod numaralarını çekebilirsek. Stok kodu olarak yazmış altında
 
merhaba tüm ürünleri çekebileceğim kodu payşabilirmisiniz yukarıdaki kodlarla sadece ürün adı ve fiyat listesi alabiliyorum
 
https://www.hapeloglu.com/ sitesinden ürün isim fiyat ve barkod numaralarını alabileceğim komut dizini konusunda yardımcı olabilecek arkadaşlar var mı acil ihtiyaç yardımcı olursanız sevinirim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst