Dış kaynaktan veri alan makronun yenilemesi hakkında

[uguraslanoglu]

Merhabalar,

Aşağıdaki gibi döviz alış, satış, kar, zarar takip edebileceğim bir tablom var. B2, B3, B4 ve B5 hücrelerindeki verileri makro ile çalıştığım bankanın (enpara) sitesinden oluşturduğum klavye kısayolu ile çekiyorum.

Fakat iki problemim var:

İlk problemim:

Makro her çalıştırıldığında arka planda internet explorer ile dış kaynaktan veri alınıyor, dolayısıyla her sorgu için CPU 1 adet iexplorer.exe işlemi oluşturuluyor.

Sorgu sayısı 14-15 taneyi geçtiğinde makro çalışamaz duruma geliyor dolayısıyla CPU'dan bu biriken internet explorer işlemlerini el ile sonlandırmak durumunda kalıyorum.

Bunun önüne geçebileceğim bir çözüm var mıdır? Internet Explorer yerine farklı bir tarayıcıya atayamaz mıyım bu makrodaki sorguyu?

Makro burada:

Sub Yenile()
Application.ScreenUpdating = False
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
Do: DoEvents: Loop Until IE.ReadyState = 4
KurAlis = IE.document.getElementsByClassName("dlCont")(1).innerText
KurSatis = IE.document.getElementsByClassName("dlCont")(2).innerText
ActiveSheet.Range("B3").Value = KurAlis
ActiveSheet.Range("B2").Value = KurSatis
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
Do: DoEvents: Loop Until IE.ReadyState = 4
KurAlis = IE.document.getElementsByClassName("dlCont")(4).innerText
KurSatis = IE.document.getElementsByClassName("dlCont")(5).innerText
ActiveSheet.Range("B5").Value = KurAlis
ActiveSheet.Range("B4").Value = KurSatis
IE.Navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
End Sub

İkinci problemim ise:

Bu sorguyu el ile değil de otomatik olarak nasıl çalıştırabilirim? Dakikada bir arka planda kendisi yenileyecek şekilde. Tabii bunun için ilk maddedeki sorunumun çözülmesi gerekiyor.

Yardımlarınızı bekliyorum. İyi forumlar.

 

[Muzaffer Ali]

Merhaba.

Kodlarınızı aşağıdakiler ile değiştirin.

Dim Zaman As Double
Const Calistir = "Yenile"

Sub Basla()
    Zaman = Now + TimeSerial(0, 1, 0)
    Application.OnTime EarliestTime:=Zaman, Procedure:=Calistir, Schedule:=True
End Sub

Sub Dur()
    On Error Resume Next
    Application.OnTime EarliestTime:=Zaman, Procedure:=Calistir, Schedule:=False
End Sub

Sub Auto_Close()
    Call Dur
End Sub

Sub Yenile()
    Application.ScreenUpdating = False
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
    Do: DoEvents: Loop Until IE.ReadyState = 4
    KurAlis = IE.document.getElementsByClassName("dlCont")(1).innerText
    KurSatis = IE.document.getElementsByClassName("dlCont")(2).innerText
    ActiveSheet.Range("B3").Value = KurAlis
    ActiveSheet.Range("B2").Value = KurSatis
   
    IE.Navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
    Do: DoEvents: Loop Until IE.ReadyState = 4
    KurAlis = IE.document.getElementsByClassName("dlCont")(4).innerText
    KurSatis = IE.document.getElementsByClassName("dlCont")(5).innerText
    ActiveSheet.Range("B5").Value = KurAlis
    ActiveSheet.Range("B4").Value = KurSatis
    IE.Navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
    Application.ScreenUpdating = True
    IE = Nothing
    Call Basla
End Sub

 

[Merhum İdris SERDAR]

.

Alternatif:

Sub Macro1()

Dim alnad As Name
For Each alnad In Application.ActiveWorkbook.Names
    alnad.Delete
Next

    Range("A3").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
      "URL;https://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx", _
         Destination:=Range("A3"))
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
   
    Range("A2:A42").EntireRow.Delete
    Range("A8:A100").EntireRow.Delete
    Range("A1").Select
   
End Sub

.

 

[uguraslanoglu]

Selamlar; şöyle bir sorun veriyor sebebi nedir acaba.

Merhaba.

Kodlarınızı aşağıdakiler ile değiştirin.

Dim Zaman As Double
Const Calistir = "Yenile"

Sub Basla()
    Zaman = Now + TimeSerial(0, 1, 0)
    Application.OnTime EarliestTime:=Zaman, Procedure:=Calistir, Schedule:=True
End Sub

Sub Dur()
    On Error Resume Next
    Application.OnTime EarliestTime:=Zaman, Procedure:=Calistir, Schedule:=False
End Sub

Sub Auto_Close()
    Call Dur
End Sub

Sub Yenile()
    Application.ScreenUpdating = False
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
    Do: DoEvents: Loop Until IE.ReadyState = 4
    KurAlis = IE.document.getElementsByClassName("dlCont")(1).innerText
    KurSatis = IE.document.getElementsByClassName("dlCont")(2).innerText
    ActiveSheet.Range("B3").Value = KurAlis
    ActiveSheet.Range("B2").Value = KurSatis

    IE.Navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
    Do: DoEvents: Loop Until IE.ReadyState = 4
    KurAlis = IE.document.getElementsByClassName("dlCont")(4).innerText
    KurSatis = IE.document.getElementsByClassName("dlCont")(5).innerText
    ActiveSheet.Range("B5").Value = KurAlis
    ActiveSheet.Range("B4").Value = KurSatis
    IE.Navigate "http://www.qnbfinansbank.enpara.com/doviz-kur-bilgileri/doviz-altin-kurlari.aspx"
    Application.ScreenUpdating = True
    IE = Nothing
    Call Basla
End Sub

Selamlar; şöyle bir sorun veriyor sebebi ne olabilir,

 

[Muzaffer Ali]

Hangi satırda bu hatayı veriyor?