AccessTr.neT

Tam Versiyon: Dosya Birleştirme
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3
(16/01/2022, 22:04)berduş yazdı: [ -> ]Yapılır yapılmasına da tam olarak  ne istediğinizi anlamazsam ilerde sorun çıkar

aslında bu isteğimi yapan hazır programların olması gerekli bence. İsteğim sadece seçilen tüm mdb dosyalarının tek 1 mdb dosyasında birleştirilmesi hocam. Hepsinde tablolar aynı isimde sadece veriler farklı onlarda data.mdb de birleştirilecek.
Seçilen tüm mdbler tek mdb de birlessin diyorsunuz, bunun anlamı; bu 5 mdb dosyasındaki 5 tablo, data.mdb dosyasına 5 farklı tablo olarak aktarılsın demektir. Ayni tabloda birleştirsin derseniz o zaman insanın aklına doğal olarak başka ihtimaller geliyor
uygun bir zamanda ilgilenmeye çalışırım
(16/01/2022, 22:19)berduş yazdı: [ -> ]Seçilen tüm mdbler tek mdb de birlessin diyorsunuz, bunun anlamı; bu 5 mdb dosyasındaki 5 tablo, data.mdb dosyasına 5 farklı tablo olarak aktarılsın demektir. Ayni tabloda birleştirsin  derseniz o zaman insanın aklına doğal olarak başka ihtimaller geliyor
uygun bir zamanda ilgilenmeye çalışırım

data.mdb dosyasında tek bir tabloda olacak işte hocam.
Boş bir veritabanı oluşturun ismi MDBBirlestir olsun
1 - önce bir form oluşturup 1 liste kutusu ve buton ekleyeceksiniz
a ) liste kutusu'nun adı : LstDB
    liste kutusu'nun satır kaynağı türü: Değer Listesi
b) dosya seçme butonunun adı: BtnDosyaSec
2 - aşağıdaki kodları formun kod sayfasına yapıştıracaksınız
tablo yoksa oluşturma varsa veri eklemesini sağlaya değişken
Aşağıdaki satır option compare.. satırının hemen altına eklenecek
Public tabloYrt As Boolean
sheet1 tablosunu oluşturma ve verileri DATA.mdb veri tabanını aktarma kodu
Sub ekle(ByVal xSQL As String, ByVal xLFilename As String)
'On Error Resume Next
    CurrentDb.Execute xSQL
    Sql = "delete * from [sheet1] IN '" & xLFilename & "'"
    CurrentDb.Execute SQL
    tabloYrt = True
End Sub
MDB dosyası oluşturma kodu
Sub MDB_olustur()
  Dim ws As Workspace
  Dim db As Database
  Dim LFilename As String
    tabloYrt = False
  'Get default Workspace
  Set ws = DBEngine.Workspaces(0)

  'Path and file name for new mdb file
  LFilename = CurrentProject.Path & "\Data.mdb"

  'Make sure there isn't already a file with the name of the new database
  If Dir(LFilename) <> "" Then Kill LFilename

  'Create a new mdb file
  Set db = ws.CreateDatabase(LFilename, dbLangGeneral)
End Sub
Buton Kodu
Private Sub BtnDosyaSec_Click()
Dim DosyaBul As Object
Dim DB_Ad_ADrs As Variant
Dim tblAdi, Tur As String
Set DosyaBul = Application.FileDialog(3)
LFilename = CurrentProject.Path & "\Data.mdb"
With DosyaBul
    .AllowMultiSelect = True
    .ButtonName = "Dosya Seç"

    .Filters.Clear
    .Filters.Add "MDB", "*.mdb"
  '  .Filters.Add "Hepsi", "*.*"
    .FilterIndex = 0
    .InitialFileName = CurrentProject.Path
    .Title = "Seç..."
        If .Show = True Then
        LstDB.RowSource = ""
        MDB_olustur
            For Each DB_Ad_ADrs In .SelectedItems
                Me.LstDB.AddItem DB_Ad_ADrs
                Sql = "SELECT * INTO [sheet1] IN '" & LFilename & "' FROM [sheet1] IN '" & DB_Ad_ADrs & "'"
                If tabloYrt = False Then ekle SQL, LFilename
               
                Sql = "Insert INTO [sheet1] IN '" & LFilename & "' SELECT * FROM [sheet1] IN '" & DB_Ad_ADrs & "'"
                CurrentDb.Execute SQL
            Next DB_Ad_ADrs
        Else
        Exit Sub
        End If
End With
End Sub

Not: eğer Data.mdb dosyası önceden oluşturulmuşsa siler yeniden oluşturur
(17/01/2022, 00:53)berduş yazdı: [ -> ]Boş bir veritabanı oluşturun ismi MDBBirlestir olsun
1 - önce bir form oluşturup 1 liste kutusu ve buton ekleyeceksiniz
a ) liste kutusu'nun adı : LstDB
    liste kutusu'nun satır kaynağı türü: Değer Listesi
b) dosya seçme butonunun adı: BtnDosyaSec
2 - aşağıdaki kodları formun kod sayfasına yapıştıracaksınız
tablo yoksa oluşturma varsa veri eklemesini sağlaya değişken
Aşağıdaki satır option compare.. satırının hemen altına eklenecek
Public tabloYrt As Boolean
sheet1 tablosunu oluşturma ve verileri DATA.mdb veri tabanını aktarma kodu
Sub ekle(ByVal xSQL As String, ByVal xLFilename As String)
'On Error Resume Next
    CurrentDb.Execute xSQL
    Sql = "delete * from [sheet1] IN '" & xLFilename & "'"
    CurrentDb.Execute SQL
    tabloYrt = True
End Sub
MDB dosyası oluşturma kodu
Sub MDB_olustur()
  Dim ws As Workspace
  Dim db As Database
  Dim LFilename As String
    tabloYrt = False
  'Get default Workspace
  Set ws = DBEngine.Workspaces(0)

  'Path and file name for new mdb file
  LFilename = CurrentProject.Path & "\Data.mdb"

  'Make sure there isn't already a file with the name of the new database
  If Dir(LFilename) <> "" Then Kill LFilename

  'Create a new mdb file
  Set db = ws.CreateDatabase(LFilename, dbLangGeneral)
End Sub
Buton Kodu
Private Sub BtnDosyaSec_Click()
Dim DosyaBul As Object
Dim DB_Ad_ADrs As Variant
Dim tblAdi, Tur As String
Set DosyaBul = Application.FileDialog(3)
LFilename = CurrentProject.Path & "\Data.mdb"
With DosyaBul
    .AllowMultiSelect = True
    .ButtonName = "Dosya Seç"

    .Filters.Clear
    .Filters.Add "MDB", "*.mdb"
  '  .Filters.Add "Hepsi", "*.*"
    .FilterIndex = 0
    .InitialFileName = CurrentProject.Path
    .Title = "Seç..."
        If .Show = True Then
        LstDB.RowSource = ""
        MDB_olustur
            For Each DB_Ad_ADrs In .SelectedItems
                Me.LstDB.AddItem DB_Ad_ADrs
                Sql = "SELECT * INTO [sheet1] IN '" & LFilename & "' FROM [sheet1] IN '" & DB_Ad_ADrs & "'"
                If tabloYrt = False Then ekle SQL, LFilename
               
                Sql = "Insert INTO [sheet1] IN '" & LFilename & "' SELECT * FROM [sheet1] IN '" & DB_Ad_ADrs & "'"
                CurrentDb.Execute SQL
            Next DB_Ad_ADrs
        Else
        Exit Sub
        End If
End With
End Sub

Not: eğer Data.mdb dosyası önceden oluşturulmuşsa siler yeniden oluşturur

Bunu görmemiştim hocam muhteşem olmuş çok teşekkürler.
(17/01/2022, 00:53)berduş yazdı: [ -> ]Boş bir veritabanı oluşturun ismi MDBBirlestir olsun
1 - önce bir form oluşturup 1 liste kutusu ve buton ekleyeceksiniz
a ) liste kutusu'nun adı : LstDB
    liste kutusu'nun satır kaynağı türü: Değer Listesi
b) dosya seçme butonunun adı: BtnDosyaSec
2 - aşağıdaki kodları formun kod sayfasına yapıştıracaksınız
tablo yoksa oluşturma varsa veri eklemesini sağlaya değişken
Aşağıdaki satır option compare.. satırının hemen altına eklenecek
Public tabloYrt As Boolean
sheet1 tablosunu oluşturma ve verileri DATA.mdb veri tabanını aktarma kodu
Sub ekle(ByVal xSQL As String, ByVal xLFilename As String)
'On Error Resume Next
    CurrentDb.Execute xSQL
    Sql = "delete * from [sheet1] IN '" & xLFilename & "'"
    CurrentDb.Execute SQL
    tabloYrt = True
End Sub
MDB dosyası oluşturma kodu
Sub MDB_olustur()
  Dim ws As Workspace
  Dim db As Database
  Dim LFilename As String
    tabloYrt = False
  'Get default Workspace
  Set ws = DBEngine.Workspaces(0)

  'Path and file name for new mdb file
  LFilename = CurrentProject.Path & "\Data.mdb"

  'Make sure there isn't already a file with the name of the new database
  If Dir(LFilename) <> "" Then Kill LFilename

  'Create a new mdb file
  Set db = ws.CreateDatabase(LFilename, dbLangGeneral)
End Sub
Buton Kodu
Private Sub BtnDosyaSec_Click()
Dim DosyaBul As Object
Dim DB_Ad_ADrs As Variant
Dim tblAdi, Tur As String
Set DosyaBul = Application.FileDialog(3)
LFilename = CurrentProject.Path & "\Data.mdb"
With DosyaBul
    .AllowMultiSelect = True
    .ButtonName = "Dosya Seç"

    .Filters.Clear
    .Filters.Add "MDB", "*.mdb"
  '  .Filters.Add "Hepsi", "*.*"
    .FilterIndex = 0
    .InitialFileName = CurrentProject.Path
    .Title = "Seç..."
        If .Show = True Then
        LstDB.RowSource = ""
        MDB_olustur
            For Each DB_Ad_ADrs In .SelectedItems
                Me.LstDB.AddItem DB_Ad_ADrs
                Sql = "SELECT * INTO [sheet1] IN '" & LFilename & "' FROM [sheet1] IN '" & DB_Ad_ADrs & "'"
                If tabloYrt = False Then ekle SQL, LFilename
               
                Sql = "Insert INTO [sheet1] IN '" & LFilename & "' SELECT * FROM [sheet1] IN '" & DB_Ad_ADrs & "'"
                CurrentDb.Execute SQL
            Next DB_Ad_ADrs
        Else
        Exit Sub
        End If
End With
End Sub

Not: eğer Data.mdb dosyası önceden oluşturulmuşsa siler yeniden oluşturur



Bugün 3 tane sağlam dosyayıda birleştirme yaptım ve sonrasında dosya bozuldu hocam.
Sayfalar: 1 2 3