TURKISH SELENIUM V2 İLE İNTERNETTEN VERİ ÇEKMEK ARTIK AŞIRI KOLAY!!! DOSYA LİNKİ AÇIKLAMADA

Описание: KURUMSAL WEB YAZILIMLARI VE VBA & EXCEL İLE İLGİLİ KURUMSAL EĞİTİMLER(SADECE FİRMALARA ÖZEL) İÇİN BANA 0532 456 53 99 NUMARASI ÜZERİNDEN ULAŞABİLİRSİNİZ.

Dosya indirmek için Windows Defender'i kapatin.
Dosya Linki: https://limewire.com/d/PtBUw#A3LWrDlRpk


Option Explicit

Dim driver As New WebDriver
Dim ws As Worksheet
Dim ws2 As Worksheet

Public Sub getDatafromWeb(control As IRibbonControl)

Dim cevap As Long
Dim i As Long

cevap = MsgBox("Verileri Almak Ister Misiniz?", _
vbInformation + vbYesNo, "Sayin " & Environ("UserName"))
If cevap = vbNo Then MsgBox "Islem Iptal Edildi", _
vbInformation, "Sayin " & Environ("UserName"): End

If Not IsInternetConnected Then
MsgBox "Internet Baglantiniz Sorunlu", _
vbExclamation, "Sayin " & Environ("UserName"): End
End If

Set ws = Sheet1: Set ws2 = Sheet2

If ws2.Range("B2").Value2 = "" Or _
ws2.Range("B3").Value2 = "" Then
With ws2
.Visible = xlSheetVisible
.Activate
Application.Goto .Range("A1"), True
End With
MsgBox "Kullanici Bilgileri Eksik", _
vbExclamation, "Sayin " & Environ("UserName"): End
End If

With ws.UsedRange
.Offset(1, 1).ClearContents
.Resize(, 1).RemoveDuplicates 1, xlYes
End If
If ws.Cells(Rows.Count, 1).End(xlUp).row = 1 Then Exit Sub

FindAndTerminate "chrome.exe"

driver.StartChrome
driver.OpenBrowser
driver.Windows(1).Maximize
driver.NavigateTo ws2.Range("B1").Value2
driver.Wait 2000

driver.FindElementByID("user-login-email").SendKeys ws2.Range("B2").Value2
driver.FindElementByID("user-login-pass").SendKeys ws2.Range("B3").Value2
driver.FindElementByXPath("//button[@class='btn btn-primary btn-block']").Click
driver.Wait 2000

For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).row

If Not Trim(ws.Cells(i, 1).Value2) = "" Then
driver.NavigateTo ws.Cells(i, 1).Value2
driver.Wait 1000

ws.Cells(i, 2) = driver.FindElementByXPath("//div[@class='product-title']").GetText
ws.Cells(i, 3) = Replace(driver.FindElementByXPath("//div[@class='product-price-old']").GetText, " TL", "", , , vbTextCompare)
ws.Cells(i, 4) = driver.FindElementsByXPath("//div[@class='product-list-content']").Item(2).GetText
ws.Cells(i, 5) = driver.FindElementByXPath("//div[@class='product-detail-tab-content']").GetText
ws.Cells(i, 6) = Application.WorksheetFunction.Clean(Replace(driver.FindElementByXPath("//div[@class='product-list-row product-categories']").GetText, "Kategori", "", , , vbTextCompare))
ws.Cells(i, 7) = driver.FindElementByXPath("//img[@id='primary-image']").GetAttribute("src")

Rem driver.FindElementByXPath("//a[@class='add-to-cart-button'][text()='Sepete Ekle']").Click
End If

Next i

driver.CloseBrowser
driver.Shutdown

ws.UsedRange.EntireColumn.AutoFit
ThisWorkbook.Save

MsgBox "Verileriniz Alinmistir", vbInformation, "Sayin " & Environ("UserName")

End Sub
Private Sub FindAndTerminate(ByVal strProcName As String)

Dim objWMIService As Object
Dim objProcess As Object
Dim colProcess As Object
Dim strComputer As String

On Error Resume Next: strComputer = "."

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & strProcName & "'")

For Each objProcess In colProcess
objProcess.Terminate
Next objProcess
On Error GoTo 0

End Sub