- Katılım
- 11 Mart 2005
- Mesajlar
- 3,058
- Excel Vers. ve Dili
- Office 2013 İngilizce
Merhaba,
Aşağıda yer alan siteden fiyat bilgisini almaya çalışıyorum, fakat bir bir türlü beceremedemim.
yardımcı olursanız sevinirim,
https://www.amazon.com/dp/B07WCKPWFS?th=1
Aşağıda yer alan siteden fiyat bilgisini almaya çalışıyorum, fakat bir bir türlü beceremedemim.
yardımcı olursanız sevinirim,
https://www.amazon.com/dp/B07WCKPWFS?th=1
Kod:
Sub Fiyat_Al_Aktar()
On Error Resume Next
Dim IE As New InternetExplorer
Dim doc As HTMLDocument
Dim r As Long, Dim c As Byte
Dim htmlDOC As MSHTML.HTMLDocument
Dim htmlTablo As MSHTML.IHTMLElementCollection
Dim htmlSatir As MSHTML.IHTMLElement
Dim htmlElaman As MSHTML.IHTMLElement
Application.DisplayAlerts = False
Sheets("Data").Cells.Clear
Sheets("Data").Activate
With IE
.Visible = False
.navigate "https://www.amazon.com/dp/B07WCKPWFS?th=1"
End With
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Set htmlDOC = IE.document
Application.Wait (Now + TimeValue("00:00:01"))
r = 0
c = 1
Stop
divStr = "a-section a-spacing-none _p13n-desktop-sims-fbt_fbt-desktop_price-points-box__1xGfe"
Set htmlTablo = doc.getElementsByClassName(divStr)
r=2
c=2
For Each htmlElaman In htmlTablo
If htmlElaman.innerText like "Total price:*"
Sheets("Data").Cells(r, c) = htmlElaman.innerText
End If
Next htmlElaman
Sheets("Data").Range("A:D").EntireColumn.AutoFit
40:
Application.DisplayAlerts = True
IE.Quit
Set htmlDOC = Nothing
MsgBox "İşlem Tamam", vbInformation, "Bilgi"
End Sub
Ekli dosyalar
-
116 KB Görüntüleme: 9
-
98.9 KB Görüntüleme: 9