• Foruma hoş geldin 👋 Ziyaretçi

    Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı ya da giriş yapmalısınız. Foruma üye olmak tamamen ücretsizdir.

    Giriş yap veya Şimdi kayıt ol

Çözüldü vba ile webden veri çekme

Bu konu çözüldü olarak işaretlenmiştir. Çözülmediğini düşünüyorsanız konuyu rapor edebilirsiniz.
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
burakgunes

burakgunes

Yeni Üye
Katılım
12 Ağu 2021
Mesajlar
65
Çözümler
1
Aldığı beğeni
23
Excel V
Office 365 TR

Ekli dosyalar

Çözüm
oilgun
Modül kodlarınızı şu şekilde değiştirin.
C#: 
Sub getirakakce()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim sayfa As Worksheet
For Each sayfa In ThisWorkbook.Sheets
If sayfa.Name <> Sayfa1.Name Then
sayfa.Delete
End If
Next sayfa
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub akakcecek()
Call getirakakce

Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
 Dim link As String
Dim row As Integer
Dim sonsat As Integer
Dim url As String
Dim i As Integer
Dim li, tr

sonsat = Sheets("Akakce").Range("A10000").End(xlUp).row

For i = 2 To sonsat

url = Sheets("Akakce").Cells(i, 2)

XMLReq.Open "GET", url, False
XMLReq.setRequestHeader "cf-cache-status"...
Tarihe göre sırala Oylara göre sırala
kabataslak bir denemede ilgili verileri alınabildiğini gördüm -resim hariç- .
ben doğrudan excelin webden veri alma özelliğini kullandım veriler geliyor ama nereye eklenecek hangi sayfa? hangi sütun hangi satır?
ayrıca benim aldığım yöntemde şöyle bir sorun var ürün için kullanılan tablo sayısı değişken mesela bağlantısını paylaştığınız üründe 4 tablo varken çalışmanızda yer alan bağlantılardan bazılarında 2 tablo tek var
 
Son düzenleme:
Olumlu oy 0 Negatif oyla
halily' Alıntı:
kabataslak bir denemede ilgili verileri alınabildiğini gördüm -resim hariç- .
ben doğrudan excelin webden veri alma özelliğini kullandım veriler geliyor ama nereye eklenecek hangi sayfa? hangi sütun hangi satır?
ayrıca benim aldığım yöntemde şöyle bir sorun var ürün için kullanılan tablo sayısı değişken mesela bağlantısını paylaştığınız üründe 4 tablo varken çalışmanızda yer alan bağlantılardan bazılarında 2 tablo tek var
Genişletmek için tıkla...
Evet tablo sayısı değişken olduğu için webden veri al özelliğini kullanamıyorum vba ile çekmeye çalışıyorum
 
Olumlu oy 0 Negatif oyla
halily' Alıntı:
kabataslak bir denemede ilgili verileri alınabildiğini gördüm -resim hariç- .
ben doğrudan excelin webden veri alma özelliğini kullandım veriler geliyor ama nereye eklenecek hangi sayfa? hangi sütun hangi satır?
ayrıca benim aldığım yöntemde şöyle bir sorun var ürün için kullanılan tablo sayısı değişken mesela bağlantısını paylaştığınız üründe 4 tablo varken çalışmanızda yer alan bağlantılardan bazılarında 2 tablo tek var
Genişletmek için tıkla...
Sayfanın tamamını çekip içerisinden özellikleri alıyorum Ama şöyle bir şeye ihtiyacım var. Özellikleri tablo olarak indirdim excelime diğer sayfada ilgili barkodun karşına yapıştırıyorum ama şunu istiyorum

Kullanım Türü: Solo
Program Sayısı: 4 Programlı
Kapasite: 13 Kişilik
Kontrol Paneli: Analog
Çatal Kaşık Bölme Tipi: Sepetli
Enerji Sınıfı:
Renk: Gümüş

Yukarıdaki Şekilde excel sayfama indirdim Kullanım Türü Program Sayısı vs Özellik başlıklarını Diğer tabloda stun olarak ekleyip Altınada bu sütunların karşısındaki Değerleri yazdırmak istiyorum Devrik dönüş gibi ama şöyle bir sorun var tabloyu alt alta birden fazla linkten oluşturacağım için Yapamıyorum
 
Olumlu oy 0 Negatif oyla
Modül kodlarınızı şu şekilde değiştirin.
C#: 
Sub getirakakce()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim sayfa As Worksheet
For Each sayfa In ThisWorkbook.Sheets
If sayfa.Name <> Sayfa1.Name Then
sayfa.Delete
End If
Next sayfa
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub akakcecek()
Call getirakakce

Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
 Dim link As String
Dim row As Integer
Dim sonsat As Integer
Dim url As String
Dim i As Integer
Dim li, tr

sonsat = Sheets("Akakce").Range("A10000").End(xlUp).row

For i = 2 To sonsat

url = Sheets("Akakce").Cells(i, 2)

XMLReq.Open "GET", url, False
XMLReq.setRequestHeader "cf-cache-status", "DYNAMIC"
XMLReq.setRequestHeader "content-type", "txt/html"
XMLReq.setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/94.0.4606.81 Safari/537.36"
XMLReq.send allbody

If XMLReq.Status <> 500 Then
    
    Sheets("Akakce").Range("C" & i) = "Fiyat Çekilemedi"

End If

HTMLDoc.body.innerHTML = (XMLReq.responseText)





Set urunAdi = HTMLDoc.getElementsByTagName("h1")(0)

Sheets("Akakce").Cells(i, 3) = urunAdi.innerText

Dim sayfa As Worksheet
Set sayfa = sayfabul(Sheets("Akakce").Cells(i, 1).Value)

If sayfa Is Nothing Then


    Set sayfa = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    sayfa.Name = Sheets("Akakce").Cells(i, 1).Value
End If

'---

sayfa.Range("A1").Value = "Ürün Adı"
sayfa.Range("A2").Value = urunAdi.innerText
sayfa.Range("B1").Value = "Barkod"
sayfa.Range("B2").Value = sayfa.Name
sayfa.Range("C1").Value = "Link"
sayfa.Range("C2").Value = url

Dim el As HTMLSpanElement
Dim sat As Integer
sat = 2
sayfa.Range("D1").Value = "Fiyatlar"
sayfa.Range("E1").Value = "Ortalama Fiyat"
For Each el In HTMLDoc.getElementsByClassName("pb_v8")



sayfa.Range("D" & sat).Value = CCur(el.getElementsByClassName("pt_v8")(0).innerText)

sat = sat + 1

If sat = 12 Then Exit For ' fiyat gösterim limiti 10
'End If

Next el
sat = 1
sayfa.Range("E2").Value = (Application.WorksheetFunction.Average(sayfa.Range("D2:D11")))
link = HTMLDoc.getElementsByClassName("img_w")(0).getAttribute("href")
Call resimekle(sayfa, link)

For Each tr In HTMLDoc.getElementById("DT_w").getElementsByTagName("tr")

Range("G" & sat).Value = tr.getElementsByTagName("td")(0).innerText
Range("H" & sat).Value = IIf(tr.getElementsByTagName("td")(1).innerText = ":", ChrW(&H2713), tr.getElementsByTagName("td")(1).innerText)
Range("H" & sat).Value = Replace(Range("H" & sat).Value, ":  ", "")
sat = sat + 1
Next tr
sat = 1
If HTMLDoc.getElementsByClassName("icSTsc_v8").Length <> 0 Then
For Each li In HTMLDoc.getElementsByClassName("icSTsc_v8")(0).getElementsByTagName("li")

Range("I" & sat).Value = li.getElementsByTagName("b")(0).innerText
Range("J" & sat).Value = Replace(li.innerText, li.getElementsByTagName("b")(0).innerText, "")

sat = sat + 1
Next li
End If
Range("K1").Value = "Ortalama Puan"
If HTMLDoc.getElementById("UV4Pr").Children(0).Children.Length <> 0 Then
Range("K2").Value = (HTMLDoc.getElementById("UV4Pr").Children(0).Children(0).Children(2).innerText)
Else
Range("K2").Value = "-"
End If
'---
Set sayfa = Nothing

Next i

End Sub
Function sayfabul(sayfaisim As String) As Worksheet
Dim sayfa As Worksheet
 

 
For Each sayfa In ThisWorkbook.Worksheets
 
    If sayfa.Name = sayfaisim Then
        Set sayfabul = sayfa
    End If
 
Next
 
End Function
Sub resimekle(ByVal sayfa As Worksheet, link As String)
link = Replace(link, "about", "http")
Dim productImage As Picture     'Declare image picture object
Dim productImageUrlRng As Range 'Declare range object to contain image URL
Dim productImageRng As Range    'Location image will be placed
'Delete any existing pictures:


Set productImageRng = sayfa.Range("A12:J23") 'Where I want to put the image


productImageRng.Select
'productImageRng.Delete --Does not delete pictures in range
sayfa.Pictures.Delete     'Delete existing images
Set productImage = sayfa.Pictures.Insert(link)

With productImage
    .ShapeRange.LockAspectRatio = msoTrue
    '.Width = productImageRng.Width
    .Height = productImageRng.Height
    ' .Top = Rows(cl.Row).Top
    ' .Left = Columns(cl.Column).Left
End With

 End Sub


Akakçe sayfa kodlarına da şunu ekleyin.
C#: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.row = 1 Then Exit Sub
If Target.Column > 3 Then Exit Sub
Sheets(Range("A" & Target.row).Value).Activate

End Sub

"akakcecek" kodunu çalıştırarak sonuçları görün. Bakalım olmuş mu?
 
Olumlu oy 1 Negatif oyla
Çözüm
oilgun' Alıntı:
Modül kodlarınızı şu şekilde değiştirin.
C#: 
Sub getirakakce()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim sayfa As Worksheet
For Each sayfa In ThisWorkbook.Sheets
If sayfa.Name <> Sayfa1.Name Then
sayfa.Delete
End If
Next sayfa
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub akakcecek()
Call getirakakce

Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim link As String
Dim row As Integer
Dim sonsat As Integer
Dim url As String
Dim i As Integer
Dim li, tr

sonsat = Sheets("Akakce").Range("A10000").End(xlUp).row

For i = 2 To sonsat

url = Sheets("Akakce").Cells(i, 2)

XMLReq.Open "GET", url, False
XMLReq.setRequestHeader "cf-cache-status", "DYNAMIC"
XMLReq.setRequestHeader "content-type", "txt/html"
XMLReq.setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/94.0.4606.81 Safari/537.36"
XMLReq.send allbody

If XMLReq.Status <> 500 Then
   
    Sheets("Akakce").Range("C" & i) = "Fiyat Çekilemedi"

End If

HTMLDoc.body.innerHTML = (XMLReq.responseText)





Set urunAdi = HTMLDoc.getElementsByTagName("h1")(0)

Sheets("Akakce").Cells(i, 3) = urunAdi.innerText

Dim sayfa As Worksheet
Set sayfa = sayfabul(Sheets("Akakce").Cells(i, 1).Value)

If sayfa Is Nothing Then


    Set sayfa = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    sayfa.Name = Sheets("Akakce").Cells(i, 1).Value
End If

'---

sayfa.Range("A1").Value = "Ürün Adı"
sayfa.Range("A2").Value = urunAdi.innerText
sayfa.Range("B1").Value = "Barkod"
sayfa.Range("B2").Value = sayfa.Name
sayfa.Range("C1").Value = "Link"
sayfa.Range("C2").Value = url

Dim el As HTMLSpanElement
Dim sat As Integer
sat = 2
sayfa.Range("D1").Value = "Fiyatlar"
sayfa.Range("E1").Value = "Ortalama Fiyat"
For Each el In HTMLDoc.getElementsByClassName("pb_v8")



sayfa.Range("D" & sat).Value = CCur(el.getElementsByClassName("pt_v8")(0).innerText)

sat = sat + 1

If sat = 12 Then Exit For ' fiyat gösterim limiti 10
'End If

Next el
sat = 1
sayfa.Range("E2").Value = (Application.WorksheetFunction.Average(sayfa.Range("D2:D11")))
link = HTMLDoc.getElementsByClassName("img_w")(0).getAttribute("href")
Call resimekle(sayfa, link)

For Each tr In HTMLDoc.getElementById("DT_w").getElementsByTagName("tr")

Range("G" & sat).Value = tr.getElementsByTagName("td")(0).innerText
Range("H" & sat).Value = IIf(tr.getElementsByTagName("td")(1).innerText = ":", ChrW(&H2713), tr.getElementsByTagName("td")(1).innerText)
Range("H" & sat).Value = Replace(Range("H" & sat).Value, ":  ", "")
sat = sat + 1
Next tr
sat = 1
If HTMLDoc.getElementsByClassName("icSTsc_v8").Length <> 0 Then
For Each li In HTMLDoc.getElementsByClassName("icSTsc_v8")(0).getElementsByTagName("li")

Range("I" & sat).Value = li.getElementsByTagName("b")(0).innerText
Range("J" & sat).Value = Replace(li.innerText, li.getElementsByTagName("b")(0).innerText, "")

sat = sat + 1
Next li
End If
Range("K1").Value = "Ortalama Puan"
If HTMLDoc.getElementById("UV4Pr").Children(0).Children.Length <> 0 Then
Range("K2").Value = (HTMLDoc.getElementById("UV4Pr").Children(0).Children(0).Children(2).innerText)
Else
Range("K2").Value = "-"
End If
'---
Set sayfa = Nothing

Next i

End Sub
Function sayfabul(sayfaisim As String) As Worksheet
Dim sayfa As Worksheet



For Each sayfa In ThisWorkbook.Worksheets

    If sayfa.Name = sayfaisim Then
        Set sayfabul = sayfa
    End If

Next

End Function
Sub resimekle(ByVal sayfa As Worksheet, link As String)
link = Replace(link, "about", "http")
Dim productImage As Picture     'Declare image picture object
Dim productImageUrlRng As Range 'Declare range object to contain image URL
Dim productImageRng As Range    'Location image will be placed
'Delete any existing pictures:


Set productImageRng = sayfa.Range("A12:J23") 'Where I want to put the image


productImageRng.Select
'productImageRng.Delete --Does not delete pictures in range
sayfa.Pictures.Delete     'Delete existing images
Set productImage = sayfa.Pictures.Insert(link)

With productImage
    .ShapeRange.LockAspectRatio = msoTrue
    '.Width = productImageRng.Width
    .Height = productImageRng.Height
    ' .Top = Rows(cl.Row).Top
    ' .Left = Columns(cl.Column).Left
End With

End Sub


Akakçe sayfa kodlarına da şunu ekleyin.
C#: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.row = 1 Then Exit Sub
If Target.Column > 3 Then Exit Sub
Sheets(Range("A" & Target.row).Value).Activate

End Sub

"akakcecek" kodunu çalıştırarak sonuçları görün. Bakalım olmuş mu?
Genişletmek için tıkla...
Teşekkür ederim Şöyle bir sorun daha var 60 farklı link çektikten sonra ip ban yiyorum bu sorunu bir türlü çözemedim proxy atlatarak yapmaya çalıştım proxylerede ban attı çözümünü bulamadım bir türlü
 
Olumlu oy 0 Negatif oyla
burakgunes' Alıntı:
Teşekkür ederim Şöyle bir sorun daha var 60 farklı link çektikten sonra ip ban yiyorum bu sorunu bir türlü çözemedim proxy atlatarak yapmaya çalıştım proxylerede ban attı çözümünü bulamadım bir türlü
Genişletmek için tıkla...
Bunun için akakçenin destek bölümüne mesaj atıp api bilgisi istemen gerekiyor. Misal "E-Ticaret sistemim için sipariş entegrasyonu yapmak istiyorum. API kullanıcı adımın ve şifremin gönderilmesini rica ederim.". Hiç yapmadım ama araştırdığım kadarıyla gelen api bilgileri ile xml üzerinden akakce bilgilerine erişebiliyorsun.
 
Olumlu oy 0 Negatif oyla
oilgun' Alıntı:
Bunun için akakçenin destek bölümüne mesaj atıp api bilgisi istemen gerekiyor. Misal "E-Ticaret sistemim için sipariş entegrasyonu yapmak istiyorum. API kullanıcı adımın ve şifremin gönderilmesini rica ederim.". Hiç yapmadım ama araştırdığım kadarıyla gelen api bilgileri ile xml üzerinden akakce bilgilerine erişebiliyorsun.
Genişletmek için tıkla...
Api bilgisinde sadece üeün göndermek için entegrasyon kurmuşlar maalesef Neyse yapacak birşey yok Teşekkürler İlgiliniz İçin.
 
Olumlu oy 0 Negatif oyla
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
Geri
Üst