- Katılım
- 20 Ocak 2005
- Mesajlar
- 526
- Excel Vers. ve Dili
- Excel 2007 Türkçe
- Altın Üyelik Bitiş Tarihi
- 01-01-2024
Sub imece1()
' Haluk - 08/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
Range("A1:B" & Rows.Count).ClearContents
Range("A1:B1") = Array("Ürün", "Fiyat")
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
strURL = "https://www.imecemarket.com/meyve-sebze?limit=200"
objHTTP.Open "GET", strURL, False
objHTTP.send
Set HTML = CreateObject("HTMLFILE")
HTML.body.innerHTML = objHTTP.responseText
Set Divs = HTML.getElementsByTagName("div")
For x = 0 To Divs.Length - 1
If Divs(x).classname = "product-item-container" Then
iRow = iRow + 1
Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
End If
If Divs(x).classname = "price" Then
Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
End If
Next
End Sub
' Haluk - 08/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
Range("A1:B" & Rows.Count).ClearContents
Range("A1:B1") = Array("Ürün", "Fiyat")
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
strURL = "https://www.imecemarket.com/meyve-sebze?limit=200"
objHTTP.Open "GET", strURL, False
objHTTP.send
Set HTML = CreateObject("HTMLFILE")
HTML.body.innerHTML = objHTTP.responseText
Set Divs = HTML.getElementsByTagName("div")
For x = 0 To Divs.Length - 1
If Divs(x).classname = "product-item-container" Then
iRow = iRow + 1
Cells(iRow + 1, 1) = Divs(x).getElementsByTagName("a")(0).Title
End If
If Divs(x).classname = "price" Then
Cells(iRow + 1, 2) = Split(Divs(x).innerText, " ")(0) + 0
Cells(iRow + 1, 2).NumberFormat = "#,##0.00"
End If
Next
End Sub