Automatisk oprettele af Acces database

Det kan du godt forvente.....:-)

Har oprettet databaser fra Word-VBA - så skulle det vel nok kunne lade sig gøre fra Excel - men hvorfor Excel?

Alle egenskaber i en database kan aflæses via VBA og således danne grundlag for en ny.

Hvordan griber vi det an?

Jeg vil anvende Excel fordi der er her alle mine brugerflader er programmeret fra, og her alle mine grafer udarbejdes fra. Jeg havde forestillet mig at man kunne:
1. kopierer en af de eksisterende databaser (evt. en tom grunddatabase, som jeg kender adressen på)
2. Omdøbe databasen
3. Slette alle nuværende data.
Således har jeg en ny database der er tom, og døbt et navn som brugeren via en brugerflade bliver bedt om at angive.
Blot en ide, men jeg har som sagt inegn ide om hvordan en sådan VBA-kode ser ud.

OK - jeg vil gerne forsøge - vender tilbage senere!

takker :-)

Nedenstående kode er indlagt i en Excel-VBA: ThisWorkBook
OBS - for at kunne opererer med en database fra Excel skal der sættes en reference:
I Excel VBA - menupunktet  Tools | References | afkryds Microsoft DAO 3.6 Object Library - 3.6 passer til de seneste Office-versioner (DAO = DataAdgangsObjekt)

Der er IKKE i kode indlagt individuel navngivning af den nye DB

Const dbBasis = "d:\eksperten\autodb\DbBasis.mdb"  'tilpas til din basisDB
Const dbKopi = "d:\eksperten\autodb\DbKopi.mdb"    'do - kopien
Dim db As Database
Sub StartProgram()
    udførKopieringAfDb
    findTabeller
End Sub
Private Sub udførKopieringAfDb()
    FileCopy dbBasis, dbKopi
End Sub
Private Sub findTabeller()
Dim tdef As TableDef
    Set db = OpenDatabase(dbKopi)
   
    For Each tdef In db.TableDefs
        If InStr(LCase(tdef.Name), "msys") = 0 Then  'Microsoft systemtabellen
            sletTabelData tdef.Name
        End If
    Next tdef
   
    db.Close
End Sub
Private Sub sletTabelData(tabelnavn)
Dim tabel, f
    Set tabel = db.OpenRecordset(tabelnavn)
   
    For f = 1 To tabel.RecordCount
        With tabel
            .Delete
            .MoveNext
        End With
    Next f
    tabel.Close
End Sub

Super, så klarer jeg selv resten "forhåbentlig" :-)
takker, så hvis du smider et svar sååååå!!!

øhh, hvis du har et hint til hvordan jeg får den navngivet så vil jeg være taknemmelig :-)

Selv tak - du fåt lige en opdatering, hvori dit sidste spørgsmål også er løst - herudover sker der en komprimering af kopidatabasen - således at evt. autonummereringsfelter i tabellerne igen begynder med 1.

Version 2:
Const dbBasis = "d:\eksperten\autodb\DbBasis.mdb"
Const dbKopi = "d:\eksperten\autodb\DbKopi.mdb"
Dim db As Database, nytDBnavn
Sub StartProgram()
    udførKopieringAfDb
    findTabeller
   
    navngivNyDB
    komprimerNyDB
    sletKopiDB
End Sub
Private Sub udførKopieringAfDb()
    FileCopy dbBasis, dbKopi
End Sub
Private Sub findTabeller()
Dim tdef As TableDef
    Set db = OpenDatabase(dbKopi)
   
    For Each tdef In db.TableDefs
        If InStr(LCase(tdef.Name), "msys") = 0 Then
            sletTabelData tdef.Name
        End If
    Next tdef
   
    db.Close
End Sub
Private Sub navngivNyDB()
    nytDBnavn = InputBox("Navn på ny database")
End Sub
Private Sub komprimerNyDB()
    DBEngine.CompactDatabase dbKopi, "d:\eksperten\autodb\" + nytDBnavn + ".mdb"
End Sub
Private Sub sletKopiDB()
    Kill dbKopi
End Sub
Private Sub sletTabelData(tabelnavn)
Dim tabel, f
    Set tabel = db.OpenRecordset(tabelnavn)
   
    For f = 1 To tabel.RecordCount
        With tabel
            .Delete
            .MoveNext
        End With
    Next f
    tabel.Close
End Sub

takker mange gange :-)