TURKISH SELENIUM V2 İLE İNTERNETTEN VERİ ÇEKMEK ARTIK AŞIRI KOLAY!!! DOSYA LİNKİ AÇIKLAMADA скачать в хорошем качестве

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