DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Evet hocam kurdumSelenium'u kurdunuz mu?
.
Sub getAydemData2()
' Haluk - 20/05/2021
' sa4truss@gmail.com
' https://excelhaluk.blogspot.com/
Dim Driver As New WebDriver
Dim myTable As WebElement, myInput As WebElement, myButton As WebElement
Dim myArr(), iRow As Integer
Range("C2:F" & Rows.Count) = ""
NoB = Range("B" & Rows.Count).End(xlUp).Row
Driver.AddArgument "--headless"
Driver.Start "chrome"
Driver.Timeouts.Server = 20000
Driver.Get "https://www.aydemperakende.com.tr/borc-sorgula"
For i = 2 To NoB
Set myInput = Driver.FindElementByName("contract")
myInput.Clear
myInput.SendKeys Range("B" & i).Text
Set myButton = Driver.FindElementByClass("btn")
myButton.Click
' Driver.Wait 2000
On Error Resume Next
Set myTable = Driver.FindElementByClass("subscriber-content").FindElementsByTag("table")(1)
If Err Then
Cells(i, 3) = 0
Else
myArr = myTable.AsTable.Data
iRow = UBound(myArr)
For j = 2 To iRow
Cells(i, j + 1) = Val(Replace(myArr(j, 4), "TRY", ""))
Next
End If
On Error GoTo 0
Next
MsgBox "Veriler alındı...!", vbInformation
Driver.Close
Driver.Quit
End Sub
Site ağırlaştı hocam düzelince kontrol edecem ellerinize kollarınıza sağlık tekrardanSözleşme No'lar B sütunundaysa;
.C++:Sub getAydemData2() ' Haluk - 20/05/2021 ' sa4truss@gmail.com ' https://excelhaluk.blogspot.com/ Dim Driver As New WebDriver Dim myTable As WebElement, myInput As WebElement, myButton As WebElement Dim myArr(), iRow As Integer Range("C2:F" & Rows.Count) = "" NoB = Range("B" & Rows.Count).End(xlUp).Row Driver.AddArgument "--headless" Driver.Start "chrome" Driver.Timeouts.Server = 20000 Driver.Get "https://www.aydemperakende.com.tr/borc-sorgula" For i = 2 To NoB Set myInput = Driver.FindElementByName("contract") myInput.Clear myInput.SendKeys Range("B" & i).Text Set myButton = Driver.FindElementByClass("btn") myButton.Click ' Driver.Wait 2000 On Error Resume Next Set myTable = Driver.FindElementByClass("subscriber-content").FindElementsByTag("table")(1) If Err Then Cells(i, 3) = 0 Else myArr = myTable.AsTable.Data iRow = UBound(myArr) For j = 2 To iRow Cells(i, j + 1) = Replace(Replace(myArr(j, 4), "TRY", ""), ".", ",") + 0 Next End If On Error GoTo 0 Next MsgBox "Veriler alındı...!", vbInformation Driver.Close Driver.Quit End Sub
Hocam ellerinize kollarınıza emeğinize sağlık valla Allah razı olsunSözleşme No'lar B sütunundaysa;
.C++:Sub getAydemData2() ' Haluk - 20/05/2021 ' sa4truss@gmail.com ' https://excelhaluk.blogspot.com/ Dim Driver As New WebDriver Dim myTable As WebElement, myInput As WebElement, myButton As WebElement Dim myArr(), iRow As Integer Range("C2:F" & Rows.Count) = "" NoB = Range("B" & Rows.Count).End(xlUp).Row Driver.AddArgument "--headless" Driver.Start "chrome" Driver.Timeouts.Server = 20000 Driver.Get "https://www.aydemperakende.com.tr/borc-sorgula" For i = 2 To NoB Set myInput = Driver.FindElementByName("contract") myInput.Clear myInput.SendKeys Range("B" & i).Text Set myButton = Driver.FindElementByClass("btn") myButton.Click ' Driver.Wait 2000 On Error Resume Next Set myTable = Driver.FindElementByClass("subscriber-content").FindElementsByTag("table")(1) If Err Then Cells(i, 3) = 0 Else myArr = myTable.AsTable.Data iRow = UBound(myArr) For j = 2 To iRow Cells(i, j + 1) = Replace(Replace(myArr(j, 4), "TRY", ""), ".", ",") + 0 Next End If On Error GoTo 0 Next MsgBox "Veriler alındı...!", vbInformation Driver.Close Driver.Quit End Sub
Sub AboneNo()
Dim Driver As New WebDriver
Dim myInput As WebElement, myButton As WebElement
Range("C2:C" & Rows.Count) = ""
NoB = Range("B" & Rows.Count).End(xlUp).Row
Driver.AddArgument "--headless"
Driver.Start "chrome"
Driver.Timeouts.Server = 20000
Driver.Get "https://www.aydemperakende.com.tr/sozlesme-hesap-no-sorgula"
For i = 2 To NoB
Set myInput = Driver.FindElementByClass("form-control")
myInput.Clear
myInput.SendKeys Range("B" & i).Text
Driver.FindElementByClass("btn").Click
Driver.Wait 1000
Cells(i, 3) = "'" & Driver.FindElementByClass("alert-success").FindElementByTag("b").Text
Next
MsgBox "Veriler alındı...!", vbInformation
Driver.Close
Driver.Quit
End Sub
Hocam ellerinize sağlık ama sanırım chrome güncellendi ve selenium karşılığı olmadığı için kullanamıyorum hata veriyor.Aşağıdaki şekilde deneyin.
Kod:Sub AboneNo() Dim Driver As New WebDriver Dim myInput As WebElement, myButton As WebElement Range("C2:C" & Rows.Count) = "" NoB = Range("B" & Rows.Count).End(xlUp).Row Driver.AddArgument "--headless" Driver.Start "chrome" Driver.Timeouts.Server = 20000 Driver.Get "https://www.aydemperakende.com.tr/sozlesme-hesap-no-sorgula" For i = 2 To NoB Set myInput = Driver.FindElementByClass("form-control") myInput.Clear myInput.SendKeys Range("B" & i).Text Driver.FindElementByClass("btn").Click Driver.Wait 1000 Cells(i, 3) = "'" & Driver.FindElementByClass("alert-success").FindElementByTag("b").Text Next MsgBox "Veriler alındı...!", vbInformation Driver.Close Driver.Quit End Sub
Hocam ben bunu dosyaya ekleyemedim. Nasıl eklicem yardımcı olur musunuz ?Hocam ellerinize sağlık ama sanırım chrome güncellendi ve selenium karşılığı olmadığı için kullanamıyorum hata veriyor.
Sanırım benim seleniumda problem var. Sorgulaya basıyorum chrome açılıp direk kapanıyor sorgulama yapmıyorDosyanız ektedir.
Deneyip dönüş yapayım hocamHata vermiyorsa internet hızınız yavaştır. Driver.Wait 1000
ifadesindeki bini 2000 veya 3000 yapın.