(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.