Pivot Tablo Otomatik Yenileme Sorunu

[rabbace]

Merhaba,

Netsis veri tabanına Power Query ile bağlanıp, bir ürün için haftalık stok hareketini çekiyorum. Sonrasında bu stok hareketini Pivot Tablo'ya alıp, Windows Zamanlanmış Görevler yardımıyla, her hafta Salı günü ilgililere mail olarak göndertiyorum.

İlgili dosya belirtilen tarih ve saat geldiğinde otomatik açılıyor, arka planda işlemleri yapıyor, maili gönderiyor ve kendini kapatıyor.

Aşağıdaki kod ile dosya açılışında verileri 2 defa yeniletiyorum, hatta Pivot Tablo özelliklerinden açılışta yenile seçeneğini de aktifleştirdim. Fakat verileri yenilemiyor, en son nasıl kaydedildiyse o şekilde mail gönderiyor.

Nerede hata yapıyor olabilirim?

'Verileri yenile
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:15"))

'Verileri tekrar yenile
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:15"))

VBA Kodları:

Sub VerileriGonder()
    ' E-posta gönderimi için gereken Outlook objelerini tanımla
    Dim OutlookApp As Object
    Dim MailItem As Object
    
    ' Excel uyarılarını kapat
    Application.DisplayAlerts = False
    
    ' Verileri yenile
    ActiveWorkbook.RefreshAll
    Application.Wait (Now + TimeValue("0:00:15"))
    
    ActiveWorkbook.RefreshAll
    Application.Wait (Now + TimeValue("0:00:15"))
    
    ' Şu anki tarihi al
    Dim suAnkiTarih As Date
    suAnkiTarih = Date
    
    ' İçinde bulunduğumuz haftanın numarasını al
    Dim haftaNumarasi As Integer
    haftaNumarasi = WorksheetFunction.WeekNum(suAnkiTarih, vbMonday)
    
    ' Verilerin bulunduğu aralığı belirle
    Dim veriAraligi As Range
    sonD = Cells(Rows.Count, "D").End(3).Row
    Set veriAraligi = Sheets("Pivot").Range("A3:D" & sonD)
    
    ' Alıcı e-posta adresini belirle
    Dim aliciEmail As String
    aliciEmail = "xxx.yyy@zzz.com;aaa.bbb@ccc.com"
    
    ' Outlook uygulamasını başlat
    Set OutlookApp = CreateObject("Outlook.Application")
    
    ' Yeni bir e-posta oluştur
    Set MailItem = OutlookApp.CreateItem(0)
    
    ' E-posta konusunu belirle
    MailItem.Subject = "W" & haftaNumarasi & " AAA Firması Sevk Adetleri"
    
    ' Veri aralığındaki değerleri tablo olarak e-posta içeriğine ekle
    Dim tabloHTML As String
    tabloHTML = "<table border='1'>"
    
    ' Başlık satırını ekle
    tabloHTML = tabloHTML & "<tr>"
    For Each baslik In veriAraligi.Rows(1).Cells
        tabloHTML = tabloHTML & "<th>" & baslik.Value & "</th>"
    Next baslik
    tabloHTML = tabloHTML & "</tr>"
    
    ' Veri satırlarını ekle
    For satirIndex = 2 To veriAraligi.Rows.Count
        tabloHTML = tabloHTML & "<tr>"
        For Each hucre In veriAraligi.Rows(satirIndex).Cells
            tabloHTML = tabloHTML & "<td>" & hucre.Value & "</td>"
        Next hucre
        tabloHTML = tabloHTML & "</tr>"
    Next satirIndex
    
    ' Tabloyu kapat
    tabloHTML = tabloHTML & "</table>"
    
    ' E-posta içeriğini belirle
    MailItem.HTMLBody = "Merhaba," & vbCrLf & "W" & haftaNumarasi & " kadarki AAA firması sevk adetleri:" & vbCrLf & vbCrLf & tabloHTML & vbCrLf & vbCrLf & "Bu mail otomatik olarak gönderilmiştir!"
    
    ' Alıcı e-posta adresini belirle
    MailItem.To = aliciEmail
    
    ' E-postayı gönder
    MailItem.Send
    
    ' Objeleri serbest bırak
    Set OutlookApp = Nothing
    Set MailItem = Nothing
        
    ' Dosyayı kaydet
    ThisWorkbook.Save
    
    ' Excel uyarılarını tekrar aç
    Application.DisplayAlerts = True
    
    ' Excel'i kapat
    Application.Quit
End Sub

 

[HücrelereFısıldayanAdam]

Veri yenilenmeden mail gönderiyor olabilir. Her aşama için bir kontrol mekanizması ekleyebilirsiniz.
Veri yenileme işleminin tamamlanmasını beklemek için, "DoEvents" kullanmayı deneyebilirsiniz. (forumda mevcut)
veya yenileme işinin tamamlandığını kontrol edecek bir mekanizma eklenebilir.

 

[rabbace]

Anlayamadığım bir yer var; yukarıdaki kodlara aşağıdakileri ekleyip F8 ile manuel çalıştırınca tam istediğim gibi oluyor, güncel verileri çekiyor.

Fakat otomatik olarak çalışması için Workbook_Open() yaptığımda güncelleme yapmıyor.

' Verileri yenile.
    ActiveWorkbook.RefreshAll
    
    ' Bekleme süresi için başlangıç zamanını kaydet
    Dim baslangicZamani As Double
    baslangicZamani = Timer
    
    ' Bekleme süresi (saniye cinsinden)
    Dim beklemeSuresi As Double
    beklemeSuresi = 15 ' Örneğin 15 saniye
    
    ' Bekleme döngüsü
    Do While Timer - baslangicZamani < beklemeSuresi
        DoEvents ' Arka plan işlemlerinin devam etmesini sağlar
    Loop
    
    ' Pivot tabloyu yenile.
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh

 

[rabbace]

Aşağıdaki kod bloğu eklenerek problem çözüldü.

' Verileri yenile.
    Sheets("DATA").Select
    Range("A1").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
   
    Sheets("Pivot").Select
    Range("A3").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    Application.Wait (Now + TimeValue("0:00:15"))

 

[HücrelereFısıldayanAdam]

Veri yenileme işleminin tamamlanmasını beklemek için, bekleme süresi eklemişsiniz güzel bir örek olmuş.