Çözüldü 2021 Std. Versiyonda çalışan 2016 Pro versiyonda neden çalışmaz?

K

kozmo

Katılım
24 Aralık 2010
Mesajlar
24
Excel Vers. ve Dili
Microsoft® Excel® LTSC MSO (16.0.14332.20541) 32 bit Standart 2021
Altın Üyelik Bitiş Tarihi
27-10-2023
Merhaba,

Aşağıdaki kodunu paylaştığım makro işleminde evde çalıştığım bilgisayar 2021 standart versiyon burda sorunsuz çalışıyor, şirket bilgisayarımda 2016 pro versiyon mevcut denemesini yapmaya çalıştığımda
Kod: 
    Set boxBaslik = HTML.getElementsByClassName("boxTitle2 boxTitle216")(0) ' Kutu başlığı etiketini al
kısmında kaldı, nerede hata yapıyorum yardımcı olabilirmisiniz.

(Eklentilerde VB for applications, M.Excell 16.0 Object library,Ole Automation, m.o 16.0 Object library, m.HTML object library, M.Internet Controller açıktı eksik varmı bilemedim)


Kod: 
Sub VeriCek(hisseAdi As String)
    Dim IE As Object
    Dim HTML As Object
    Dim hucresindekiVeri As String
    Dim url As String

    Set IE = CreateObject("InternetExplorer.Application")
    hucresindekiVeri = Sheets("DASHBOARD").Range("C4").Value ' C4 hücresindeki değeri al
    url = "https://uzmanpara.milliyet.com.tr/borsa/hisse-senetleri/" & hucresindekiVeri

    With IE
        .Visible = False
        .navigate url
        Do While .Busy Or .readyState <> 4
            DoEvents
        Loop
        Set HTML = .document
    End With

   Sheets("Sayfa2").Range("A1").Value = ""
    Sheets("Sayfa2").Range("B2:B6").Value = ""
    Sheets("Sayfa2").Range("D3:D6").Value = ""
    Sheets("Sayfa2").Range("E3:E6").Value = ""
    Sheets("Sayfa2").Range("B9:B10").Value = ""
    Sheets("Sayfa2").Range("D9:D10").Value = ""
    Sheets("Sayfa2").Range("B13:B18").Value = ""
    Sheets("Sayfa2").Range("D13:D18").Value = ""





    ' Verileri çekme
    Dim boxBaslik As Object
    Set boxBaslik = HTML.getElementsByClassName("boxTitle2 boxTitle216")(0) ' Kutu başlığı etiketini al

    If Not boxBaslik Is Nothing Then
        Sheets("Sayfa2").Range("A1").Value = boxBaslik.innerText ' A1 hücresine yaz

        Dim genelBilgiler As Object
        Set genelBilgiler = HTML.getElementsByClassName("currency") ' Genel Bilgiler etiketlerini al

        Sheets("Sayfa2").Range("B2").Value = genelBilgiler.Item(0).ParentNode.getElementsByClassName("right")(0).innerText ' B2 hücresine yaz
        Sheets("Sayfa2").Range("B3").Value = genelBilgiler.Item(1).ParentNode.getElementsByClassName("right")(0).innerText ' B3 hücresine yaz
        Sheets("Sayfa2").Range("B4").Value = genelBilgiler.Item(2).ParentNode.getElementsByClassName("right")(0).innerText ' B4 hücresine yaz
        Sheets("Sayfa2").Range("B5").Value = genelBilgiler.Item(3).ParentNode.getElementsByClassName("right")(0).innerText ' B5 hücresine yaz
        Sheets("Sayfa2").Range("B6").Value = genelBilgiler.Item(4).ParentNode.getElementsByClassName("right")(0).innerText ' B6 hücresine yaz

        Sheets("Sayfa2").Range("D3").Value = genelBilgiler.Item(6).ParentNode.getElementsByClassName("right")(0).innerText ' D3 hücresine yaz
        Sheets("Sayfa2").Range("D4").Value = genelBilgiler.Item(7).ParentNode.getElementsByClassName("right")(0).innerText ' D4 hücresine yaz
        Sheets("Sayfa2").Range("D5").Value = genelBilgiler.Item(8).ParentNode.getElementsByClassName("right")(0).innerText ' D5 hücresine yaz
        Sheets("Sayfa2").Range("D6").Value = genelBilgiler.Item(9).ParentNode.getElementsByClassName("right")(0).innerText ' D6 hücresine yaz

        Sheets("Sayfa2").Range("E3").Value = genelBilgiler.Item(6).ParentNode.getElementsByClassName("right")(1).innerText ' E3 hücresine yaz
        Sheets("Sayfa2").Range("E4").Value = genelBilgiler.Item(7).ParentNode.getElementsByClassName("right")(1).innerText ' E4 hücresine yaz
        Sheets("Sayfa2").Range("E5").Value = genelBilgiler.Item(8).ParentNode.getElementsByClassName("right")(1).innerText ' E5 hücresine yaz
        Sheets("Sayfa2").Range("E6").Value = genelBilgiler.Item(9).ParentNode.getElementsByClassName("right")(1).innerText ' E6 hücresine yaz

        Dim teknikAnaliz As Object
        Set teknikAnaliz = HTML.getElementsByClassName("currency") '  Teknik Analiz etiketlerini al

       '  Sheets("Sayfa2").Range("A8").Value = teknikAnaliz.Item(0).innerText ' A8 hücresine yaz

        Sheets("Sayfa2").Range("B9").Value = teknikAnaliz.Item(10).ParentNode.getElementsByClassName("right")(0).innerText ' B9 hücresine yaz
        Sheets("Sayfa2").Range("B10").Value = teknikAnaliz.Item(11).ParentNode.getElementsByClassName("right")(0).innerText ' B10 hücresine yaz
        Sheets("Sayfa2").Range("D9").Value = teknikAnaliz.Item(12).ParentNode.getElementsByClassName("right")(0).innerText ' B9 hücresine yaz
        Sheets("Sayfa2").Range("D10").Value = teknikAnaliz.Item(13).ParentNode.getElementsByClassName("right")(0).innerText ' B10 hücresine yaz

        Dim temelVeriler As Object
        Set temelVeriler = HTML.getElementsByClassName("currency") ' Temel Veriler etiketlerini al

        'Sheets("Sayfa2").Range("A12").Value = temelVeriler.Item(14).ParentNode.getElementsByClassName("right")(0).innerText ' A12 hücresine yaz
        
        Sheets("Sayfa2").Range("B13").Value = temelVeriler.Item(14).ParentNode.getElementsByClassName("right")(0).innerText ' B13 hücresine yaz
        Sheets("Sayfa2").Range("B14").Value = temelVeriler.Item(15).ParentNode.getElementsByClassName("right")(0).innerText ' B14 hücresine yaz
        Sheets("Sayfa2").Range("B15").Value = temelVeriler.Item(16).ParentNode.getElementsByClassName("right")(0).innerText ' B15 hücresine yaz
        Sheets("Sayfa2").Range("B16").Value = temelVeriler.Item(17).ParentNode.getElementsByClassName("right")(0).innerText ' B16 hücresine yaz
        Sheets("Sayfa2").Range("B17").Value = temelVeriler.Item(18).ParentNode.getElementsByClassName("right")(0).innerText ' B17 hücresine yaz
        Sheets("Sayfa2").Range("B18").Value = temelVeriler.Item(19).ParentNode.getElementsByClassName("right")(0).innerText ' B18 hücresine yaz

        Sheets("Sayfa2").Range("D13").Value = temelVeriler.Item(20).ParentNode.getElementsByClassName("right")(0).innerText ' D13 hücresine yaz
        Sheets("Sayfa2").Range("D14").Value = temelVeriler.Item(21).ParentNode.getElementsByClassName("right")(0).innerText ' D14 hücresine yaz
        Sheets("Sayfa2").Range("D15").Value = temelVeriler.Item(22).ParentNode.getElementsByClassName("right")(0).innerText ' D15 hücresine yaz
        Sheets("Sayfa2").Range("D16").Value = temelVeriler.Item(23).ParentNode.getElementsByClassName("right")(0).innerText ' D16 hücresine yaz
        Sheets("Sayfa2").Range("D17").Value = temelVeriler.Item(24).ParentNode.getElementsByClassName("right")(0).innerText ' D17 hücresine yaz





    Else
        MsgBox "Kutu başlığı bulunamadı."
    End If
    


Dim acilisVeri As String
Dim sonGuncellemeVeri As String
acilisVeri = Mid(HTML.body.innerHTML, InStr(HTML.body.innerHTML, "Açılış:") + Len("Açılış:") + 1, InStr(InStr(HTML.body.innerHTML, "Açılış:"), HTML.body.innerHTML, "</div>") - InStr(HTML.body.innerHTML, "Açılış:") - Len("Açılış:") - 1)
acilisVeri = Replace(acilisVeri, "nbsp;", "") ' &nbsp; karakterlerini kaldır
acilisVeri = Trim(acilisVeri)
Sheets("Sayfa2").Range("D19").Value = acilisVeri
sonGuncellemeVeri = Mid(HTML.body.innerHTML, InStr(HTML.body.innerHTML, "Son Güncelleme : ") + Len("Son Güncelleme : ") + 1, InStr(InStr(HTML.body.innerHTML, "Son Güncelleme : "), HTML.body.innerHTML, "</div>") - InStr(HTML.body.innerHTML, "Son Güncelleme : ") - Len("Son Güncelleme : ") - 1)
sonGuncellemeVeri = Trim(sonGuncellemeVeri)
Sheets("Sayfa2").Range("D20").Value = sonGuncellemeVeri
    
    
    

    

    IE.Quit
    Set IE = Nothing
    Set HTML = Nothing
End Sub
 
K

kozmo

Katılım
24 Aralık 2010
Mesajlar
24
Excel Vers. ve Dili
Microsoft® Excel® LTSC MSO (16.0.14332.20541) 32 bit Standart 2021
Altın Üyelik Bitiş Tarihi
27-10-2023
Versiyon farkından dolayı neden çalışmaz?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,746
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kodu nasıl kullanıyorsunuz..
 
Haluk

Haluk

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,383
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
"Internet Explorer" nesnesiyle veri çekmek yerine aşağıdaki kodda olduğu gibi XMLHTTP nesnesi kullanırsanız, bir sorun yaşamazsınız bence...

C#: 
Sub Test()
'   Haluk - 29/08/2023

    Dim objHTTP As Object, strURL As String
    Dim HTML As Object, Tables As Object, Table As Object
    Dim x As Integer, i As Long, iRow As Long, j As Integer
 
    Range("A1:G" & Rows.Count).Clear
 
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    strURL = "https://uzmanpara.milliyet.com.tr/borsa/hisse-senetleri/adel-kalemcilik-adel/"
 
    objHTTP.Open "GET", strURL, False
    objHTTP.send

    Set HTML = CreateObject("HTMLFILE")
    HTML.body.innerHTML = objHTTP.responseText
 
    Range("C1") = HTML.getElementsByTagName("h1")(0).innerText
    
    Set Tables = HTML.getElementsByTagName("table")
    
    Range("A2") = "Hisse Genel Bilgileri"
 
    Set myTable = Tables(0)
    
    iRow = 2
  
    For i = 0 To myTable.Rows.Length - 1
        iRow = iRow + 1
        For j = 0 To myTable.Rows(i).Cells.Length - 1
            If j > 0 Then
                Cells(iRow, j + 1) = Replace(myTable.Rows(i).Cells(j).innerText, ",", ".")
                Cells(iRow, j + 1).NumberFormat = "0.00"
            Else
                Cells(iRow, j + 1) = myTable.Rows(i).Cells(j).innerText
            End If
        Next
    Next
    
    Set myTable = Tables(1)
    
    iRow = 2
  
    For i = 0 To myTable.Rows.Length - 1
        iRow = iRow + 1
        For j = 0 To myTable.Rows(i).Cells.Length - 1
            If j > 0 Then
                Cells(iRow, j + 5) = Replace(myTable.Rows(i).Cells(j).innerText, ",", ".")
                Cells(iRow, j + 5).NumberFormat = "0.00"
            Else
                Cells(iRow, j + 5) = myTable.Rows(i).Cells(j).innerText
            End If
         Next
    Next
    
 
    Range("A10") = "Teknik Analiz"
    
    Set myTable = Tables(2)
    
    iRow = 10
  
    For i = 0 To myTable.Rows.Length - 1
        iRow = iRow + 1
        For j = 0 To myTable.Rows(i).Cells.Length - 1
            If j > 0 Then
                Cells(iRow, j + 1) = Replace(myTable.Rows(i).Cells(j).innerText, ",", ".")
                Cells(iRow, j + 1).NumberFormat = "0.00"
            Else
                Cells(iRow, j + 1) = myTable.Rows(i).Cells(j).innerText
            End If
        Next
    Next
        
        
    Set myTable = Tables(3)
    
    iRow = 10
  
    For i = 0 To myTable.Rows.Length - 1
        iRow = iRow + 1
        For j = 0 To myTable.Rows(i).Cells.Length - 1
            If j > 0 Then
                Cells(iRow, j + 5) = Replace(myTable.Rows(i).Cells(j).innerText, ",", ".") + 0
                Cells(iRow, j + 5).NumberFormat = "#,##0.00"
            Else
                Cells(iRow, j + 5) = myTable.Rows(i).Cells(j).innerText
            End If
        Next
    Next
    
    
    Range("A15") = "Temel Veriler"
   
    Set myTable = Tables(4)
    
    iRow = 15
  
    For i = 0 To myTable.Rows.Length - 1
        iRow = iRow + 1
        For j = 0 To myTable.Rows(i).Cells.Length - 1
            If j > 0 And iRow < 21 Then
                Cells(iRow, j + 1) = Replace(myTable.Rows(i).Cells(j).innerText, ".", "") + 0
                Cells(iRow, j + 1).NumberFormat = "0.00"
            Else
                Cells(iRow, j + 1) = myTable.Rows(i).Cells(j).innerText
            End If
        Next
    Next
    
    Set myTable = Tables(5)
    
    iRow = 15
  
    For i = 0 To myTable.Rows.Length - 1
        iRow = iRow + 1
        For j = 0 To myTable.Rows(i).Cells.Length - 1
            If j > 0 Then
                Cells(iRow, j + 5) = Replace(myTable.Rows(i).Cells(j).innerText, ",", ".") + 0
                Cells(iRow, j + 5).NumberFormat = "#,##0.00"
            Else
                Cells(iRow, j + 5) = myTable.Rows(i).Cells(j).innerText
            End If
        Next
    Next
 
Range("C1,A2,A10,A15").Font.Bold = True
End Sub

.
 

Ekli dosyalar

Son düzenleme:
K

kozmo

Katılım
24 Aralık 2010
Mesajlar
24
Excel Vers. ve Dili
Microsoft® Excel® LTSC MSO (16.0.14332.20541) 32 bit Standart 2021
Altın Üyelik Bitiş Tarihi
27-10-2023
Teşekkürler farklı versiyonlarda da denedim sorunsuz çalışıyor eline sağlık..
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst