[VBA] Veritabanları Arası şartlı Tablo Kopyalama

BeyTor · 17-07-2023, 00:53

Merhabalar,

2 tane access veritabanım mevcut. Birinde aktif tablolarım mevcut diğeri ise backup için tutuyorum. Aktif kullandığım veritabanından backup olan veritabanına tablomu VBA ile timer ile kopyalama sağlıyorum fakat, aynı isimde bir tablo varsa "yedek (1)" veya "yedek (2)" gibi yapmasını istiyorum. varolan tablonun üstüne kayıt yapıp eski tabloda ki verileri yok etmesini istemiyorum. bunu Excel çıktısında başarılı VBA düzenledim fakat iki access arasında yaparken hatalar alıyorum.

Size aşağıda örnek bir kodlamamı bırakıyorum. Biraz karışık veya mantıklarımda hatalar olabilir Eek

Ayrıca bu kod umarım ihtiyacınızı da giderir.

Geri dönüşlerinizi ve yardımlarınızı bekliyorum

Visual Basic
Function m1()
 
    ' Yedek alınacak veritabanı yolu
    strKaynakPath = CurrentProject.Path & "\database\DBkaynak.accdb"
 
    ' backup veritabanı konumu
    strYedekDB = CurrentProject.Path & "\backup\backup_db.accdb"
 
    ' Oluşturulan Yedek DB bilgisi
    strYedekTbl = Format(Date, "dd") & "_" & Format(Date, "mmmm") & "_" & "kayit"
 
    ' Yedekleme işlemi
    Set objAccess = CreateObject("Access.Application")
    objAccess.OpenCurrentDatabase strKaynakPath
    objAccess.DoCmd.CopyObject strYedekDB, strYedekTbl, acTable, "kayit"
    objAccess.CloseCurrentDatabase
    objAccess.Quit
    
    ' -------------------------------------
    ' Excel Prosedürü
    Dim BTkayit As String
    Dim BTexcel As String
    Dim btName As String
    Dim btNameWithoutExt As String
    Dim btExtension As String
    Dim counter As Integer
    
    ' Tablo
    BTkayit = "kayit"
    
    ' Kaydedilecek konum
    BTexcel = Environ("USERPROFILE") & "\Desktop\"
    
    ' Çıktı bilgisi
    btNameWithoutExt = Format(Date, "mmmm") & " " & "-" & " " & Format(Date, "dd.mm.yyyy")
    btExtension = ".xls"
    btName = BTexcel & btNameWithoutExt & btExtension
    
    ' Kopya kontrolü
    counter = 1
    Do While Dir(btName) <> ""
        counter = counter + 1
        btName = BTexcel & btNameWithoutExt & " güncel " & counter & btExtension
    Loop
    
    ' Excel çıktı komutu
    DoCmd.OutputTo acOutputTable, BTkayit, acFormatXLS, btName
    
    ' Ana tabloyu sıfırlama
    CurrentDb.Execute "DELETE FROM kayit;"
    
    
    ' İşlem tamamlandı mesajı
    MsgBox "Yedekleme tamamlandı. EXCEL dosyası masaüstüne kayıt edildi." & vbNewLine & vbNewLine & vbNewLine & "...OTOMASYONU KAPATIP AÇINIZ...", vbApplicationModal + vbInformation, "BeyTor"
End Function

BeyTor · 19-07-2023, 01:17

Sanırım herkes tatildi

dsezgin · 19-07-2023, 13:21

Yazdığınız koda ek satırla, strYedekTbl 1, 2. 3.... oluşturulacak veritabanın da

Visual Basic
Dim Tbl As TableDef
Dim Sy, EnBuyuk As Long
      strYedekTbl = Format(Date, "dd") & "_" & Format(Date, "mmmm") & "_" & "kayit"
For Each Tbl In CurrentDb.TableDefs
    If UBound(Split(Tbl.Name, strYedekTbl)) > 0 Then Sy = Sy + 1
Next Tbl
Debug.Print strYedekTbl & IIf(Sy = 0, vbNullString, "(" & Sy + 1 & ")")

prosedürü ile yeni tablo adı üretilir.

veya

Sizin yazdığınız koda ek olarak
...
...
Dim Syc As Long
Syc = objAccess.DCount("*", "M_SysObjects", "[Name]='" & strYedekTbl & "'")
strYedekTbl = strYedekTbl & IIf(Syc = 0, vbNullString, "(" & Syc + 1 & ")")

objAccess.DoCmd.CopyObject strYedekDB, strYedekTbl, acTable, "kayit"
...
...

şeklinde yeni tablo adı belirlenebilir.

NOT : M_SysObjects kelimesindeki _ karakterini silin.(Sistem dosyası olduğu için sayfada HATA verdi)

onur_can · 20-07-2023, 10:34

Merhaba Sn BeyTor,
Aşağıdaki alt yordam ile işleminiz başarılı bir şekilde yapılacaktır. Bu alt yordamı bir modül oluşturup kodları içine ekleyin.

Visual Basic
Public Sub m1()
Dim strKaynakPath As String
Dim strYedekDB As String
Dim strYedekTbl As String
Dim objAccess As Object
Dim BTkayit As String
Dim BTexcel As String
Dim btName As String
Dim btNameWithoutExt As String
Dim btExtension As String
Dim counter As Integer
 
    ' Yedek alınacak veritabanı yolu
    strKaynakPath = CurrentProject.Path & "\database\DBkaynak.accdb"
 
    ' backup veritabanı konumu
    strYedekDB = CurrentProject.Path & "\backup\backup_db.accdb"
 
    ' Oluşturulan Yedek DB bilgisi
    strYedekTbl = Format(Date, "dd") & "_" & Format(Date, "mmmm") & "_" & "kayit"
 
    ' Yedekleme işlemi
    Set objAccess = CreateObject("Access.Application")
    objAccess.OpenCurrentDatabase strKaynakPath
    objAccess.DoCmd.CopyObject strYedekDB, strYedekTbl, acTable, "kayit"
    objAccess.CloseCurrentDatabase
    objAccess.Quit
    
    ' -------------------------------------
    ' Excel Prosedürü
   
    ' Tablo
    BTkayit = "kayit"
    
    ' Kaydedilecek konum
    BTexcel = Environ("USERPROFILE") & "\Desktop\"
    
    ' Çıktı bilgisi
    btNameWithoutExt = Format(Date, "mmmm") & " " & "-" & " " & Format(Date, "dd.mm.yyyy")
    btExtension = ".xls"
    btName = BTexcel & btNameWithoutExt & btExtension
    
    ' Kopya kontrolü
    counter = 1
    Do While Dir(btName) <> ""
        counter = counter + 1
        btName = BTexcel & btNameWithoutExt & " güncel " & counter & btExtension
    Loop
    
    ' Excel çıktı komutu
    DoCmd.OutputTo acOutputTable, BTkayit, acFormatXLS, btName
    
    ' Ana tabloyu sıfırlama
    CurrentDb.Execute "DELETE FROM kayit;"
    
    
    ' İşlem tamamlandı mesajı
    MsgBox "Yedekleme tamamlandı. EXCEL dosyası masaüstüne kayıt edildi." & vbNewLine & vbNewLine & vbNewLine & "...OTOMASYONU KAPATIP AÇINIZ...", vbApplicationModal + vbInformation, "BeyTor"
End Sub

Çağırma işleminide

Visual Basic
Call m1

ile yapabilirsiniz.
iyi çalışmalar...

BeyTor · 21-07-2023, 19:19

Sn. onur_can hocam, kodda bir değişiklik görmedim sadece dağınık kod düzenim toparlanmış görünüyor. Kopya alacak veritabanın da var olan tarihte bir tablo olduğunda eski kayıtları silip yenisini yazıyor. Bense bunu yapması yerine Örn: "21_TEMMUZ_2023_kayit" isimli tablo varsa eğer bunu yanına ilave olarak parantez içinde (1) yapabilir.

Sn. dsezgin hocam, tam olarak istediğim olay bu değil. Veritabanları arasında kopyalama yapılınca oluşturulan tablo formatı "Format(Date, "dd") & "_" & Format(Date, "mmmm") & "_" & "kayit" şeklinde biçimlendirme olacak. Buna ilave olarak eğer aynı biçimde bir tablo veritabanına kopyalarken tespit edilirse, tablo isminin sonuna "(1)" gibi stackleme yapsın. Bu sayede kayıtlar üst üste bindiğinde veriler kayıp olmayacak. Çünkü yedekleme sonrasında tablo sıfırlanıyor.

cevaplarınız ve ilginiz için çok teşekkürler Cute

dsezgin · 22-07-2023, 00:29

(21-07-2023, 19:19)BeyTor demiş ki: Sn. dsezgin hocam, tam olarak istediğim olay bu değil. Veritabanları arasında kopyalama yapılınca oluşturulan tablo formatı "Format(Date, "dd") & "_" & Format(Date, "mmmm") & "_" & "kayit" şeklinde biçimlendirme olacak. Buna ilave olarak eğer aynı biçimde bir tablo veritabanına kopyalarken tespit edilirse, tablo isminin sonuna "(1)" gibi stackleme yapsın. Bu sayede kayıtlar üst üste bindiğinde veriler kayıp olmayacak. Çünkü yedekleme sonrasında tablo sıfırlanıyor.

Mesaj 3 Güncelledim.
...
Dim Syc As Long
Syc = objAccess.DCount("*", "M_SysObjects", "[Name]='" & strYedekTbl & "'")
strYedekTbl = strYedekTbl & IIf(Syc = 0, vbNullString, "(" & Syc + 1 & ")")
...

NOT: M_SysObjects yazılı olan yerdeki alt tire(_) karakterini silmeyi unutma

Benzer Konular...
Konu:		Yazar	Cevaplar:	Gösterim:	Son Mesaj
	[VBA] Birden çok Seçenek Seçili Alandaki Verileri Kopyalama	evidi	9	676	26-02-2025, 17:36 Son Mesaj: evidi
	[FORM] Tarihler Arası Toplam Veri Getirme	omergenc7	5	504	18-02-2025, 15:11 Son Mesaj: halily
	[RAPOR] Kayıt Içerisindeki Miktar Alanındaki Sayı Kadar Rapora Ilgili Kaydı Rapora Kopyalama	gurolk	12	1.002	29-07-2024, 12:01 Son Mesaj: dsezgin
	Sorguda Tarihler Arası Veri Alma	metınaycıcek	8	687	18-07-2024, 14:28 Son Mesaj: metınaycıcek
	[TABLO] Tablolar Arası Veri	Pasham	5	410	10-07-2024, 14:11 Son Mesaj: Pasham
	[VBA] Tablolar Arası Dağılım	benuva	1	406	09-02-2024, 00:56 Son Mesaj: halily
	[SORGU] Tablo2'den Tablo1'e şartlı Veri Girişi.	ŞabanTR	4	448	19-01-2024, 20:17 Son Mesaj: ŞabanTR
	[FORM] Pdf Içerik Kopyalama Ve Yapıtırma	orderyazbim	2	543	26-10-2023, 15:39 Son Mesaj: serdem48

Oturum Aç




Beni Hatırla Şifremi Unuttum?

Access SQL