Skip to main content

AccessTr.neT


İlişkili Tabloları Yedekleme

İlişkili Tabloları Yedekleme

Çözüldü #1
Hocalarım oluşturduğum tablolardan 2 sini başka bir Access dosyası oluşturarak içerisine bu tabloları yedeklemeyi yapıyor
Ana programda tablolar birbirleri ile ilişkili fakat yedek oluşturduğu yerde ilişkili olarak kopyalamadığı için yedekten geri yükle yaptığım zaman ana programın ilişkisi iptal oluyor ve programın akışında sıkıntı oluşturup hatalar vermesine sebep oluyor

Tablolardaki ilişki bozulmadan  ilişkili olarak nasıl kopyalamasını (yedeklemesini ve yedekten güncellemesini) sağlarım yardımcı olursanız çok sevinirim

[Resim: do.php?img=10804]

Yedeklemesini istediğim tablolar
Ana_giriş ve Şüpheli_Mağdurlar tabloları


Dosyanın örneği ekte
.rar örnek.rar (Dosya Boyutu: 548,41 KB | İndirme Sayısı: 3)
Değişimde gelişimde beyinlerin değişmesi ve gelişmesi ile olur. By Bibib
Son Düzenleme: 16/03/2021, 01:11, Düzenleyen: bibib.
Cevapla
#2
Ben fazla incelemedim ancak,ilk gördüğüm dosya adını "Yedek_Data.dat" olarak kayıt ediyorsunuz,neden "dat" da "mdb"veya "accdb" değil accesin uzantısı mdb veya accdb dir.bence site içinde arama yaparsanız çok güzel yedekleme örnekleri var.Arama yapın o örnekleri kendinize uyarlayın
Cevapla
#3
dilerim işinize yarar
yapılanlar
1 - ilişkileri kaydetmek için yeni bir tablo eklendi
2 - yeniden ilişkilendirmek için yazılan fonksiyonlar için modül eklendi
3 - referanslara  ActiveX Data Object Library eklendi
sorunsuz çalışırsa tablo yerine ilişkiler diziye aktarılıp oradan da alınabilir
modüle eklenen kodlar
1 - ilişkileri alma ve kaydetme
Visual Basic Code
Sub CbIliskiAl() 'ilişkileri alma ve kaydetme
CurrentDb.Execute " delete from TblIliski "
For Each rel In CurrentDb.Relations
    With rel
    If Left(.Name, 4) <> "MSys" Then
        IliskiAd = .Name
        IliskiOzellik = .Attributes
        IliskiAnaTbl = .Table
        IliskiForeignTbl = .ForeignTable
        For Each fld In .Fields
            IliskiAlan = fld.Name
            IliskiForeignAlan = fld.ForeignName
            CurrentDb.Execute " INSERT INTO TblIliski " _
            & "(IliskiAd, AnaTabloAd, HedefTabloAd,AnaAlanAd,HedefALanAd,AlanAtrib) VALUES " _
            & "('" & IliskiAd & "', '" & IliskiAnaTbl & "', '" & IliskiForeignTbl & "', '" & IliskiAlan & "', '" & IliskiForeignAlan & "'," & IliskiOzellik & ");"
        Next
    End If
    End With
Next
End Sub
2 - İlişkileri Silme
Visual Basic Code
 Sub CbIliskiSil() 'İlişkileri Silme
    For Each rel In CurrentDb.Relations
      If Left(rel.Name, 4) <> "MSys" Then CurrentDb.Relations.Delete (rel.Name)
    Next rel
End Sub
3 - İlişkileri yeniden oluşturma
Visual Basic Code
 Sub CBIliskiKur()
    
Dim SQL As String
Dim ADO_RS As ADODB.Recordset

Set ADO_RS = New ADODB.Recordset
SQL = "select * from [TblIliski]"
ADO_RS.Open SQL, CurrentProject.Connection, 3, 1
    Set db = CurrentDb
    
  With ADO_RS
      Do Until .EOF
            Set newRelation = db.CreateRelation(.Fields(0), .Fields(1), .Fields(2))
            Set relatingField = newRelation.CreateField(.Fields(3))  'The field from the primary table.
            relatingField.ForeignName = .Fields(4)                  'Matching field from the related table.
            newRelation.Fields.Append relatingField                      'Add the field to the relation's Fields collection.
            newRelation.Attributes = .Fields(5)
            db.Relations.Append newRelation
        .MoveNext
      Loop
  End With

ADO_RS.Close
Set ADO_RS = Nothing    'Attributes
    Set db = Nothing '    CreateRelation = True
End Sub
.rar DB_iliskiSil_Kur_hy4.rar (Dosya Boyutu: 259 KB | İndirme Sayısı: 2)
Cevapla
#4
Bu da tablo eklemeden yapılan
dilerim işinize yarar

sadece geriyükleme butonunun kodu değişti
Visual Basic Code
Private Sub Komut4_Click()

'------------İÇE AKTARMA KISMI---------------------

'On Error GoTo içe_aktar_hata:
'--------Dosya Aktarma değerleri-----------
    Dim GIliski As DAO.Relation
    Dim dbs As DAO.Database
    Dim GAlinanVeriTabani As String
    Dim fld As DAO.Field
      
'--------Klasör oluşturma değerleri-----------
Dim GDizin As String
Dim GKlasör As String
'--------dosya Oluşturma değerleri-----------
Dim dbNEW As DAO.Database
'-------dosya isimleri değerleri-------------
Dim Dosya1 As String
Dim Dosya2 As String
'---------------------------------------------
Dim MSJ1 As String
Dim MSJ2 As String
Dim MSJ3 As String
Dim MSJ4 As String
Dim MSJ5 As String
Dim MSJ6 As String
Dim MSJ7 As String
Dim MSJ8 As String
Dim MSJ9 As String
Dim MSJ10 As String
'-------------Hata Durumunda Verilecek Hata Mesajı----------------------------------
    MSJ1 = "Programı Çalıştırdığınız Klasör içerisinde Yedekleme Dosyası Bulunamadı.." & vbCrLf & vbCrLf
    MSJ2 = "Nedenleri.." & vbCrLf
    MSJ3 = "1) Daha Önce Yedek Alınmamış olabilir..." & vbCrLf
    MSJ4 = "2) Yedekleme Dosyası Başka Bir Klasöre Taşınmış Olabilir..." & vbCrLf & vbCrLf
    MSJ5 = "Yapılması Gerekenler.." & vbCrLf
    MSJ6 = "(Yedek_Data.dat) İsimli Yedekleme Dosyasını" & vbCrLf
    MSJ7 = "( " & GDizin & " ) Klasörü İçerine" & vbCrLf
    MSJ8 = "Uzlaştırma Programınızın Bulunduğu Klasöre Kopyaladıktan Sonra Deneyin..."
 
'---------------- Klasör Varmı Kontrolü Ediliyor -------------------
GDizin = CurrentProject.path & "\" & "Data_Yedek\"
GKlasör = Len(Dir(GDizin, vbDirectory))

If GKlasör = 0 Then
  
'-------------Klasör Bulunamadı Hata Mesajı -----------------------------
MsgBox MSJ1 & MSJ2 & MSJ3 & MSJ4 & MSJ5 & MSJ6 & MSJ7 & MSJ8, , "VERİ GÜNCELLEME HATASI": GoTo içe_aktar_çıkış
 End If
'---------------- Dosya Varmı Kontrolü Ediliyor -------------------
If Dir(GDizin & "Yedek_Data.dat") <> "Yedek_Data.dat" Then
'-------------Dosya Bulunamadı Hata Mesajı -----------------------------
    MsgBox MSJ1 & MSJ2 & MSJ3 & MSJ4 & MSJ5 & MSJ6 & MSJ7, , "VERİ GÜNCELLEME HATASI": GoTo içe_aktar_çıkış
End If

GAlinanVeriTabani = GDizin & "Yedek_Data.dat"

    GAlinanVeriTabani = GDizin & "Yedek_Data.dat"

'-----------------dosya aktarılıyor --------------
Dosya1 = "Ana_Giris_Eski"
Dosya2 = "Süpheli_Mağdurlar_Eski"

GKontrol1 = False
GKontrol2 = False

DoCmd.SetWarnings False

'hy_____________________________________________________Tablo İlişkilerini Al
 Dim DiziTblIliski() As Variant
  i = 0
  ReDim DiziTblIliski(i, 6)
  
For Each rel In CurrentDb.Relations
    With rel
        If Left(.Name, 4) <> "MSys" Then
        ReDim DiziTblIliski(i, 6)
        DiziTblIliski(i, 0) = .Name
        DiziTblIliski(i, 1) = .Table
        DiziTblIliski(i, 2) = .ForeignTable
        DiziTblIliski(i, 5) = .Attributes
    
            For Each fld In .Fields
                DiziTblIliski(i, 3) = fld.Name
                DiziTblIliski(i, 4) = fld.ForeignName
            Next
        i = i + 1
        End If
    End With
Next

'hy_____________________________________________________Tablo İlişkilerini Al BİTTİ

'hy_____________________________________________________Tablo İlişkilerini Sil BİTTİ
    For Each rel In CurrentDb.Relations
      If Left(rel.Name, 4) <> "MSys" Then CurrentDb.Relations.Delete (rel.Name)
    Next rel
'hy_____________________________________________________Tablo İlişkilerini Sil BİTTİ
    '-----------------Öncelikli olarak eski ana tablo siliniyor----------
Call Delete_Dosya_Varmı '----DOSYALARIN OLUP OLMADIĞI KONTROL ETTİRİLİYOR--------


If GKontrol1 = True Then
  CurrentDb.Execute "DROP TABLE " & Dosya2 & ";"  ' tabloyu siler
  Else
End If

If GKontrol2 = True Then
  CurrentDb.Execute "DROP TABLE " & Dosya1 & ";" ' tabloyu siler
  Else
End If
    '----------------------------------------------------------------------
        
    '-----Sonra mevcut ana tablo isimleri değiştiriliyor--------------
Dosya1 = "Süpheli_Mağdurlar"
Dosya2 = "Ana_Giris"
GKontrol1 = False
GKontrol2 = False

Call Readme_Dosya_Varmı

If GKontrol3 = False Then
    DoCmd.Rename Dosya1 & "_Eski", acTable, Dosya1 'tablo ismi değişltirme
  End If
        
If GKontrol4 = False Then
    DoCmd.Rename Dosya2 & "_Eski", acTable, Dosya2 'tablo ismi değişltirme
End If
 DoCmd.SetWarnings True
'---------------------------------------------------------------------------------

    '------------------------------------------------------------
    '---------------------------- Yedek Database den Tablolar aktarılıyor --------------------------------
    DoCmd.TransferDatabase acImport, "Microsoft Access", GAlinanVeriTabani, acTable, Dosya1, Dosya1, False
    DoCmd.TransferDatabase acImport, "Microsoft Access", GAlinanVeriTabani, acTable, Dosya2, Dosya2, False
    '-----------------------------------------------------------------------------------------------------
'hy_____________________________________________________Tablo İlişkilerini Yeniden Kur
Set db = CurrentDb
For x = LBound(DiziTblIliski, 1) To UBound(DiziTblIliski, 1)
            Set newRelation = db.CreateRelation(CStr(DiziTblIliski(x, 0)), CStr(DiziTblIliski(x, 1)), CStr(DiziTblIliski(x, 2)))
            Set relatingField = newRelation.CreateField(CStr(DiziTblIliski(x, 3)))  'The field from the primary table.
            relatingField.ForeignName = CStr(DiziTblIliski(x, 4))                  'Matching field from the related table.
            newRelation.Fields.Append relatingField                      'Add the field to the relation's Fields collection.
            newRelation.Attributes = CLng(DiziTblIliski(x, 5))
            db.Relations.Append newRelation
Next x
'hy_____________________________________________________Tablo İlişkilerini Yeniden Kur BİTTİ
MsgBox "Yedek Datalardan Verilerin Aktarımı Tamamlandı...", , "GÜNCELLEME...": GoTo içe_aktar_çıkış:


içe_aktar_hata:
If Err.Number = 3343 Then
    MsgBox "Yedek Dosyanız Açılamıyor... Bozuk veya Tanımsız Dosya..." & vbCrLf & vbCrLf & Space(25) & "İŞLEM GERÇEKLEŞTİRİLEMEDİ... (Hata: 01)", , "VERİ GÜNCELLEME HATASI"
End If
If Err.Number = 3011 Then
    MsgBox "Dosya İçerisinde Verileri Bulamıyor... Bozulmuş veya Değiştirilmiş Olabilir..." & vbCrLf & vbCrLf & Space(30) & "İŞLEM GERÇEKLEŞTİRİLEMEDİ... (Hata: 02)", , "VERİ GÜNCELLEME HATASI"
End If
If Err.Number = 3376 Then
    MsgBox "Dosya İçerisinde Verileri Bulamıyor... Bozulmuş veya Değiştirilmiş Olabilir..." & vbCrLf & vbCrLf & Space(30) & "İŞLEM GERÇEKLEŞTİRİLEMEDİ... (Hata: 03)", , "VERİ GÜNCELLEME HATASI"
End If
içe_aktar_çıkış:
End Sub
aşağıdakiler zaten yukardaki kodun içinde yer alıyor burada sadece ilgili kısımlar var
ilişkileri diziye alma kodu
Visual Basic Code
'hy_____________________________________________________Tablo İlişkilerini Al
 Dim DiziTblIliski() As Variant
  i = 0
  ReDim DiziTblIliski(i, 6)
  
For Each rel In CurrentDb.Relations
    With rel
        If Left(.Name, 4) <> "MSys" Then
        ReDim DiziTblIliski(i, 6)
        DiziTblIliski(i, 0) = .Name
        DiziTblIliski(i, 1) = .Table
        DiziTblIliski(i, 2) = .ForeignTable
        DiziTblIliski(i, 5) = .Attributes
    
            For Each fld In .Fields
                DiziTblIliski(i, 3) = fld.Name
                DiziTblIliski(i, 4) = fld.ForeignName
            Next
        i = i + 1
        End If
    End With
Next
İlişkileri silme kodu
Visual Basic Code
'hy_____________________________________________________Tablo İlişkilerini Sil BİTTİ
    For Each rel In CurrentDb.Relations
      If Left(rel.Name, 4) <> "MSys" Then CurrentDb.Relations.Delete (rel.Name)
    Next rel
İlişkileri yeniden oluşturma kodu
Visual Basic Code
'hy_____________________________________________________Tablo İlişkilerini Yeniden Kur
Set db = CurrentDb
For x = LBound(DiziTblIliski, 1) To UBound(DiziTblIliski, 1)
            Set newRelation = db.CreateRelation(CStr(DiziTblIliski(x, 0)), CStr(DiziTblIliski(x, 1)), CStr(DiziTblIliski(x, 2)))
            Set relatingField = newRelation.CreateField(CStr(DiziTblIliski(x, 3)))  'The field from the primary table.
            relatingField.ForeignName = CStr(DiziTblIliski(x, 4))                  'Matching field from the related table.
            newRelation.Fields.Append relatingField                      'Add the field to the relation's Fields collection.
            newRelation.Attributes = CLng(DiziTblIliski(x, 5))
            db.Relations.Append newRelation
Next x
.rar DB_iliskiSil_Kur_hy9.rar (Dosya Boyutu: 259,68 KB | İndirme Sayısı: 2)
Cevapla
#5
(16/03/2021 12:38)C*e*l*o*y*c*e Adlı Kullanıcıdan Alıntı: Ben fazla incelemedim ancak,ilk gördüğüm dosya adını "Yedek_Data.dat" olarak kayıt ediyorsunuz,neden "dat" da "mdb"veya "accdb" değil accesin uzantısı mdb veya accdb dir.bence site içinde arama yaparsanız çok güzel yedekleme örnekleri var.Arama yapın o örnekleri kendinize uyarlayın


Hocam (.dat) uzantı aslında (.mdb) uzantı ben kullanıcı yedek oluşturduktan sonra müdahale etmesin diye uzantısının ismini değiştirdim

araştırdım siteyi zaten bu yazdılan kodları da yine sitede bulduğum siz değerli hocaların ve arkadaşların örneklerinden faydalanarak hazırladım lakin yukarıda belirttiğim olayla ilgili bir örnek bulamadım veya araştırmayı beceremedim affınıza

(17/03/2021 00:13)berduş Adlı Kullanıcıdan Alıntı: Bu da tablo eklemeden yapılan
dilerim işinize yarar

sadece geriyükleme butonunun kodu değişti
Visual Basic Code
Private Sub Komut4_Click()

'------------İÇE AKTARMA KISMI---------------------

'On Error GoTo içe_aktar_hata:
'--------Dosya Aktarma değerleri-----------
    Dim GIliski As DAO.Relation
    Dim dbs As DAO.Database
    Dim GAlinanVeriTabani As String
    Dim fld As DAO.Field
      
'--------Klasör oluşturma değerleri-----------
Dim GDizin As String
Dim GKlasör As String
'--------dosya Oluşturma değerleri-----------
Dim dbNEW As DAO.Database
'-------dosya isimleri değerleri-------------
Dim Dosya1 As String
Dim Dosya2 As String
'---------------------------------------------
Dim MSJ1 As String
Dim MSJ2 As String
Dim MSJ3 As String
Dim MSJ4 As String
Dim MSJ5 As String
Dim MSJ6 As String
Dim MSJ7 As String
Dim MSJ8 As String
Dim MSJ9 As String
Dim MSJ10 As String
'-------------Hata Durumunda Verilecek Hata Mesajı----------------------------------
    MSJ1 = "Programı Çalıştırdığınız Klasör içerisinde Yedekleme Dosyası Bulunamadı.." & vbCrLf & vbCrLf
    MSJ2 = "Nedenleri.." & vbCrLf
    MSJ3 = "1) Daha Önce Yedek Alınmamış olabilir..." & vbCrLf
    MSJ4 = "2) Yedekleme Dosyası Başka Bir Klasöre Taşınmış Olabilir..." & vbCrLf & vbCrLf
    MSJ5 = "Yapılması Gerekenler.." & vbCrLf
    MSJ6 = "(Yedek_Data.dat) İsimli Yedekleme Dosyasını" & vbCrLf
    MSJ7 = "( " & GDizin & " ) Klasörü İçerine" & vbCrLf
    MSJ8 = "Uzlaştırma Programınızın Bulunduğu Klasöre Kopyaladıktan Sonra Deneyin..."
 
'---------------- Klasör Varmı Kontrolü Ediliyor -------------------
GDizin = CurrentProject.path & "\" & "Data_Yedek\"
GKlasör = Len(Dir(GDizin, vbDirectory))

If GKlasör = 0 Then
  
'-------------Klasör Bulunamadı Hata Mesajı -----------------------------
MsgBox MSJ1 & MSJ2 & MSJ3 & MSJ4 & MSJ5 & MSJ6 & MSJ7 & MSJ8, , "VERİ GÜNCELLEME HATASI": GoTo içe_aktar_çıkış
 End If
'---------------- Dosya Varmı Kontrolü Ediliyor -------------------
If Dir(GDizin & "Yedek_Data.dat") <> "Yedek_Data.dat" Then
'-------------Dosya Bulunamadı Hata Mesajı -----------------------------
    MsgBox MSJ1 & MSJ2 & MSJ3 & MSJ4 & MSJ5 & MSJ6 & MSJ7, , "VERİ GÜNCELLEME HATASI": GoTo içe_aktar_çıkış
End If

GAlinanVeriTabani = GDizin & "Yedek_Data.dat"

    GAlinanVeriTabani = GDizin & "Yedek_Data.dat"

'-----------------dosya aktarılıyor --------------
Dosya1 = "Ana_Giris_Eski"
Dosya2 = "Süpheli_Mağdurlar_Eski"

GKontrol1 = False
GKontrol2 = False

DoCmd.SetWarnings False

'hy_____________________________________________________Tablo İlişkilerini Al
 Dim DiziTblIliski() As Variant
  i = 0
  ReDim DiziTblIliski(i, 6)
  
For Each rel In CurrentDb.Relations
    With rel
        If Left(.Name, 4) <> "MSys" Then
        ReDim DiziTblIliski(i, 6)
        DiziTblIliski(i, 0) = .Name
        DiziTblIliski(i, 1) = .Table
        DiziTblIliski(i, 2) = .ForeignTable
        DiziTblIliski(i, 5) = .Attributes
    
            For Each fld In .Fields
                DiziTblIliski(i, 3) = fld.Name
                DiziTblIliski(i, 4) = fld.ForeignName
            Next
        i = i + 1
        End If
    End With
Next

'hy_____________________________________________________Tablo İlişkilerini Al BİTTİ

'hy_____________________________________________________Tablo İlişkilerini Sil BİTTİ
    For Each rel In CurrentDb.Relations
      If Left(rel.Name, 4) <> "MSys" Then CurrentDb.Relations.Delete (rel.Name)
    Next rel
'hy_____________________________________________________Tablo İlişkilerini Sil BİTTİ
    '-----------------Öncelikli olarak eski ana tablo siliniyor----------
Call Delete_Dosya_Varmı '----DOSYALARIN OLUP OLMADIĞI KONTROL ETTİRİLİYOR--------


If GKontrol1 = True Then
  CurrentDb.Execute "DROP TABLE " & Dosya2 & ";"  ' tabloyu siler
  Else
End If

If GKontrol2 = True Then
  CurrentDb.Execute "DROP TABLE " & Dosya1 & ";" ' tabloyu siler
  Else
End If
    '----------------------------------------------------------------------
        
    '-----Sonra mevcut ana tablo isimleri değiştiriliyor--------------
Dosya1 = "Süpheli_Mağdurlar"
Dosya2 = "Ana_Giris"
GKontrol1 = False
GKontrol2 = False

Call Readme_Dosya_Varmı

If GKontrol3 = False Then
    DoCmd.Rename Dosya1 & "_Eski", acTable, Dosya1 'tablo ismi değişltirme
  End If
        
If GKontrol4 = False Then
    DoCmd.Rename Dosya2 & "_Eski", acTable, Dosya2 'tablo ismi değişltirme
End If
 DoCmd.SetWarnings True
'---------------------------------------------------------------------------------

    '------------------------------------------------------------
    '---------------------------- Yedek Database den Tablolar aktarılıyor --------------------------------
    DoCmd.TransferDatabase acImport, "Microsoft Access", GAlinanVeriTabani, acTable, Dosya1, Dosya1, False
    DoCmd.TransferDatabase acImport, "Microsoft Access", GAlinanVeriTabani, acTable, Dosya2, Dosya2, False
    '-----------------------------------------------------------------------------------------------------
'hy_____________________________________________________Tablo İlişkilerini Yeniden Kur
Set db = CurrentDb
For x = LBound(DiziTblIliski, 1) To UBound(DiziTblIliski, 1)
            Set newRelation = db.CreateRelation(CStr(DiziTblIliski(x, 0)), CStr(DiziTblIliski(x, 1)), CStr(DiziTblIliski(x, 2)))
            Set relatingField = newRelation.CreateField(CStr(DiziTblIliski(x, 3)))  'The field from the primary table.
            relatingField.ForeignName = CStr(DiziTblIliski(x, 4))                  'Matching field from the related table.
            newRelation.Fields.Append relatingField                      'Add the field to the relation's Fields collection.
            newRelation.Attributes = CLng(DiziTblIliski(x, 5))
            db.Relations.Append newRelation
Next x
'hy_____________________________________________________Tablo İlişkilerini Yeniden Kur BİTTİ
MsgBox "Yedek Datalardan Verilerin Aktarımı Tamamlandı...", , "GÜNCELLEME...": GoTo içe_aktar_çıkış:


içe_aktar_hata:
If Err.Number = 3343 Then
    MsgBox "Yedek Dosyanız Açılamıyor... Bozuk veya Tanımsız Dosya..." & vbCrLf & vbCrLf & Space(25) & "İŞLEM GERÇEKLEŞTİRİLEMEDİ... (Hata: 01)", , "VERİ GÜNCELLEME HATASI"
End If
If Err.Number = 3011 Then
    MsgBox "Dosya İçerisinde Verileri Bulamıyor... Bozulmuş veya Değiştirilmiş Olabilir..." & vbCrLf & vbCrLf & Space(30) & "İŞLEM GERÇEKLEŞTİRİLEMEDİ... (Hata: 02)", , "VERİ GÜNCELLEME HATASI"
End If
If Err.Number = 3376 Then
    MsgBox "Dosya İçerisinde Verileri Bulamıyor... Bozulmuş veya Değiştirilmiş Olabilir..." & vbCrLf & vbCrLf & Space(30) & "İŞLEM GERÇEKLEŞTİRİLEMEDİ... (Hata: 03)", , "VERİ GÜNCELLEME HATASI"
End If
içe_aktar_çıkış:
End Sub
aşağıdakiler zaten yukardaki kodun içinde yer alıyor burada sadece ilgili kısımlar var
ilişkileri diziye alma kodu
Visual Basic Code
'hy_____________________________________________________Tablo İlişkilerini Al
 Dim DiziTblIliski() As Variant
  i = 0
  ReDim DiziTblIliski(i, 6)
  
For Each rel In CurrentDb.Relations
    With rel
        If Left(.Name, 4) <> "MSys" Then
        ReDim DiziTblIliski(i, 6)
        DiziTblIliski(i, 0) = .Name
        DiziTblIliski(i, 1) = .Table
        DiziTblIliski(i, 2) = .ForeignTable
        DiziTblIliski(i, 5) = .Attributes
    
            For Each fld In .Fields
                DiziTblIliski(i, 3) = fld.Name
                DiziTblIliski(i, 4) = fld.ForeignName
            Next
        i = i + 1
        End If
    End With
Next
İlişkileri silme kodu
Visual Basic Code
'hy_____________________________________________________Tablo İlişkilerini Sil BİTTİ
    For Each rel In CurrentDb.Relations
      If Left(rel.Name, 4) <> "MSys" Then CurrentDb.Relations.Delete (rel.Name)
    Next rel
İlişkileri yeniden oluşturma kodu
Visual Basic Code
'hy_____________________________________________________Tablo İlişkilerini Yeniden Kur
Set db = CurrentDb
For x = LBound(DiziTblIliski, 1) To UBound(DiziTblIliski, 1)
            Set newRelation = db.CreateRelation(CStr(DiziTblIliski(x, 0)), CStr(DiziTblIliski(x, 1)), CStr(DiziTblIliski(x, 2)))
            Set relatingField = newRelation.CreateField(CStr(DiziTblIliski(x, 3)))  'The field from the primary table.
            relatingField.ForeignName = CStr(DiziTblIliski(x, 4))                  'Matching field from the related table.
            newRelation.Fields.Append relatingField                      'Add the field to the relation's Fields collection.
            newRelation.Attributes = CLng(DiziTblIliski(x, 5))
            db.Relations.Append newRelation
Next x



Hocam elinize sağlık inceleyip denedikten sonra en kısa sürede geri bildirim yapacağım verdiğiniz emek ve uğraş için çok teşekkür ederim ellerinize sağlık
Değişimde gelişimde beyinlerin değişmesi ve gelişmesi ile olur. By Bibib
Son Düzenleme: 17/03/2021, 16:42, Düzenleyen: bibib.
Cevapla
#6
Berduş Hocam ellerinize sağlık sorunsuz çalıştı.

konuyu kapatabilirsiniz.
Değişimde gelişimde beyinlerin değişmesi ve gelişmesi ile olur. By Bibib
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da