vba kodu ile yeni bir vt oluşturmak

Çalışılmakta olan veritabanından Vba kodu ile farklı yeni bir veritabanı oluşturabilir miyiz?

Bir butonun tıklanma olayında aşağıdaki kodu yazacak olursanız :

1- Sıfırdan bir dosya oluşturulur. Eğer oluşturulmak istenen dosya varsa uyarı alırsınız.
2- Dosya içinde bir tablo oluşturursunuz.
3- Dosyanızda yeni alanlar oluşturursunuz.

Dim ADOXcatalog As New ADOX.Catalog

Dim ADOXtable As New Table

Dim ADOXindex As New ADOX.Index



On Error GoTo hata_yakala

ADOXcatalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\AccessTRyeniDB.mdb"



On Error Resume Next



ADOXcatalog.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\AccessTRyeniDB.mdb"





ADOXtable.Name = "tbl_yeni_tablo"

ADOXtable.Columns.Append "musteri_id", adInteger

ADOXtable.Columns.Append "ad", adVarWChar, 40

ADOXtable.Columns.Append "soyad", adVarWChar, 20



ADOXcatalog.Tables.Append ADOXtable



hata_yakala:

    If Err.Number = -2147217897 Then

        MsgBox "Bu veritabanı zaten var", vbInformation + vbOKOnly, "Dosya zaten var"

    ElseIf Err.Number <> 0 Then

        MsgBox "Hata : " & Err.Description

    End If



    Set ADOXtable = Nothing

    Set ADOXindex = Nothing

    Set ADOXcatalog = Nothing

NOT : Bu kodların çalışması için Reference içinden "Microsoft ADO Ext. 2.x for DDL and Security" yüklenmiş olmalıdır.

Yanıtınız için teşekkürler.Sorunum yardımınızla çözüldü.Veritabanının dizinde olmaması durumu ve tabloyu sorgu ile yeni oluşturulan vt içersine eklemeyle birleştirerek yazılan kodun son halini aşağı ekledim.

Dim DOSYA, DURUM, ad, yol, ara, MESAJ

Dim ADOXtable As New Table

Dim ADOXindex As New ADOX.Index

Dim ADOXcatalog As New ADOX.Catalog



ad = CurrentProject.Name

  yol = "c:\Vt\toplu\" & ad

    ara = Dir(yol)

   

   If (ara = "") Then

     MsgBox "Web Güncelle komutunu sadece  Programın " & Chr(13) & "Kurulu olduğu" _

     & "bilgisayarda kullanabilirsiniz", vbOKOnly + vbInformation, "Bilgilendirme"

          

   Else

DOSYA = CurrentProject.Path & "\web.mdb"

  DURUM = Dir(DOSYA)

        

   If (DURUM = "") Then

   MESAJ = MsgBox("Güncelleştirmek istediğiniz veritabanı silinmiş" _

   & Chr(13) & "Tekrar oluşturmak ister misiniz?", vbYesNo + vbQuestion, " Yardım")

   

   If MESAJ = vbYes Then

 ADOXcatalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\web.mdb"

   DoCmd.SetWarnings False

    DoCmd.OpenQuery "webb"

     DoCmd.SetWarnings True

End If



   Else

  DoCmd.SetWarnings False

    DoCmd.OpenQuery "webb"

      DoCmd.SetWarnings True

 End If

 End If