Soru Macro hata veriyor

[k0081]

Merhaba arkadaşlar,
daha önceleri sorunsuz çalışan makro, şu kısımda hata veriyor ? :

Set List = HTML.getElementById("list") 'page

Sub DemirAL()

Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.demirfiyatlari.com/"
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("htmlFile")
    HTML.body.innerhtml = objHTTP.responseText

Set List = HTML.getElementById("list") 'page

yardımcı olacak arkadaşa şimdiden teşekkürler.

 

[muratboz06]

https://www.demirfiyatlari.com/ sitesinde list isminde element yok.
Websitesinde değişiklik yapmış olabilirler.

 

[k0081]

Evet olabilir. Bir de site açılışına bir ileti koyulmuş. Bu daha önce yoktu

 

[muratboz06]

Makro kodunun tamamını paylaşır mısınız, birde ekran görüntüsü ile almak istediğiniz alanı belirtirseniz yardımcı olabiliriz.

 

[k0081]

Sub DemirAL()

Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.demirfiyatlari.com/"
  
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("htmlFile")
    HTML.body.innerhtml = objHTTP.responseText

Set List = HTML.getElementById("list") 'page
Set div = List.GetElementsByTagName("DIV") 'http://www.demirfiyatlari.com/
baslik = div(0).innertext 'Başlık yazısı Günü Tarihini Güncelleme tarihi




a = 3 'Çapları burdan itibaren yaz. yani B3 satırından

'DEMİR ÇAPLARI BAŞI
Set th = List.GetElementsByTagName("TH") 'Q8  Q10 Q12 ve Q32 kısmı
For i = 0 To 3
Sheets("MalzemeGuncelFiyatlar").Cells(a, i + 1) = th(i).innertext
Next i
a = a + 1
'DEMİR ÇAPLARI SONU
  
Range("A1").Value = baslik
Range("A2").Value = "http://www.demirfiyatlari.com/"

Set Tbody = List.GetElementsByTagName("TBODY") 'Tbody ti Internet.App
For Each Tr In Tbody(0).document.all.tags("TR") 'Tbody ti IE yerine kullandım.
For f = 0 To Tr.all.tags("TD").Length - 1
Sheets("MalzemeGuncelFiyatlar").Cells(a, f + 1) = Tr.all.tags("TD").Item(f).innertext 'TD : Demir fiyatları ve iller
Next f
a = a + 1
Next
'.......................... Tbody, TD, TR, TH, Content, Table = bu değişkenlerin hepsi web sitesinin içindeki kodlardıR.
Range("A3").Value = "1 ton Fiyatıdır."
MsgBox "Güleç Demir den Demir Fiyatları Alındı", vbInformation
    Set objHTTP = Nothing
    Set HTML = Nothing
    Set List = Nothing
    Set div = Nothing
    Set th = Nothing
    Set Tbody = Nothing
    Set Tr = Nothing
    Set td = Nothing
End Sub

1tv6n7e.png

ekran1

www.hizliresim.com

 

[Haluk]

Sub DemirAL2()
'   Haluk - 11/10/2021
'   sa4truss@gmail.com
'   https://excelhaluk.blogspot.com/
    
    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim i As Long, iRow As Long, j As Integer
    
    Range("A1:D" & Rows.Count) = ""
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.demirfiyatlari.com/"
    
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("htmlFile")
    HTML.body.innerhtml = objHTTP.responseText
    
    Set Tables = HTML.getElementsByTagName("table")
    Set MyTable = Tables(0)
    
    For i = 0 To MyTable.Rows.Length - 1
        iRow = iRow + 1
        For j = 0 To MyTable.Rows(i).Cells.Length - 1
            Cells(iRow, j + 1) = Replace(MyTable.Rows(i).Cells(j).innerText, "TL", "")
        Next
    Next
 End Sub

.

 

[k0081]

@Haluk

Çok Teşekkür ederim , Tamamdır. Elinize sağlık

 

[k0081]

@Haluk

hocam, tablonun ilk başlığındaki : tarih ve kdv dahil nakliye hariç yazan kısım.

Bunu başlık olarak almalıyım. A1 e. Bunu nasıl yapabilirim ? ( formatlı tabloma uyarladım. sadece bu kısım kaldı.)

Range("A1").Value = baslik

 

[Haluk]

O zaman ilk önce VBA editörde "Microsoft HTML Object Library" referansını seçeceksiniz.

Daha sonra, eskisinin yerine aşağıdaki kodu kullanacaksınız....

Sub DemirAL3()
'   Haluk - 11/10/2021
'   sa4truss@gmail.com
'   https://excelhaluk.blogspot.com/
   
    Dim objHTTP As Object, strURL As String
    Dim HTML As HTMLDocument, Tables As Object, Table As Object
    Dim i As Long, iRow As Long, j As Integer
    Dim xData As Object
   
    Range("A1:D" & Rows.Count) = ""
   
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    strURL = "https://www.demirfiyatlari.com/"
   
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = New HTMLDocument
    HTML.body.innerhtml = objHTTP.responseText
   
    Set Tables = HTML.getElementsByTagName("table")
    Set MyTable = Tables(0)
   
    For i = 0 To MyTable.Rows.Length - 1
        iRow = iRow + 1
        For j = 0 To MyTable.Rows(i).Cells.Length - 1
            Cells(iRow, j + 1) = Replace(MyTable.Rows(i).Cells(j).innerText, "TL", "")
        Next
    Next
   
    Set xData = HTML.getElementsByClassName("card-header bg-color-grey text-3")(2)
   
    Range("A1") = xData.innerText
End Sub

.

 

[k0081]

Tamamdır. Hocam çok Teşekkürler., -- Bu akşam için son 1 soru :

sizin daha önce göndermiş olduğunuz kod ile altıpiyasası isimli siteden verileri aldım.

yalnız karakterler Türkçe değil. bunu nasıl düzeltebilirim ?

Ekran resmi ekliyorum

1ax3mgs.png

karakter

www.hizliresim.com

 

[Haluk]

Bu akşamlık bu kadar yeter zira; bugün katarakt ameliyatı oldum, tek gözle yardımcı olmaya çalışıyorum....

.

 

[k0081]

Abi tamamdır. Çok geçmiş olsun.

 

[Haluk]

Eyvallah....sağolasın.

.

 

[Orion1]

Bu akşamlık bu kadar yeter zira; bugün katarakt ameliyatı oldum, tek gözle yardımcı olmaya çalışıyorum....

.

Geçmiş olsun üstadım.

 

[Haluk]

Teşekkürler Evren Bey, sağolun...

.

 

[Zeki Gürsoy]

Geçmiş olsun üstad. Herşeyin başı sağlık...

 

[Haluk]

Eyvallah dostum.... aynen öyle

 

[Necdet]

Haluk bey, geçmiş olsun. Bu genç yaşta katarakt oluyor muymuş?

 

[Haluk]

Haluk bey, geçmiş olsun. Bu genç yaşta katarakt oluyor muymuş?

Valla, Memati bile yaşlanmış artık ....

Teşekkürler Necdet Bey...

.

 

[ÖmerFaruk]

Bu akşamlık bu kadar yeter zira; bugün katarakt ameliyatı oldum, tek gözle yardımcı olmaya çalışıyorum....

.

Çok geçmiş olsun Haluk Bey.
Allah şafi ismiyle şifa versin.