(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
sheet1 tablosunu oluşturma ve verileri DATA.mdb veri tabanını aktarma koduPublic tabloYrt As Boolean
MDB dosyası oluşturma koduSub 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
Buton KoduSub 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
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.