Dankenbanken erzeugen
16.01.2018 09:47:10
Steffen
folgende Funktion möchte ich realisieren:
per VBA sollen mehrere Datenbanken in einem Ordner angelegt werden, je Datenbank sollen dann mehrere Tabellen erzeugt werden deren Aufbau immer identisch ist.
Ich bekomme es hin die Datenbanken anzulegen, doch mir fehlt der richtige Tipp wie ich die Datenbank öffne und Tabellen erzeuge.
Wäre um jede Hilfe Dankbar.
folgenden Code habe ich:
Sub ACCerstellen()
Dim NL() As String, DBPATH As String
Dim i As Long
Dim acc As New Access.Application
Dim db0 As New ADODB.Connection
Dim tbl As TableDef
NL = Split("004;007", ";")
For i = 0 To UBound(NL)
Set acc = New Access.Application
acc.NewCurrentDatabase "O:\2018\" & NL(i) & ".accdb"
Set acc = Nothing
DBPATH = "O:\2018\" & NL(i) & ".accdb"
db0.ConnectionString = openDB(DBPATH)
db0.Open
On Error GoTo TabelleErstellen_Err
Set tbl = db0.CreateTableDef("tblKontakte")
With tbl
.Fields.Append .CreateField("Testfeld1", dbLong)
.Fields.Append .CreateField("Testfeld1", dbText, 50)
.Fields.Append .CreateField("Testfeld1", dbText, 50)
End With
db0.TableDefs.Append tbl
TabelleErstellen_Exit:
Set tbl = Nothing
Set db = Nothing
Exit Sub
TabelleErstellen_Err:
If Err.Number = 3010 Then
MsgBox "Die Tabelle existiert bereits."
GoTo TabelleErstellen_Exit
End If
db0.close
Next
End Sub
Public Function openDB(DBPATH As String)
Dim strDBCONN As String
If Right(DBPATH, 4) = "xlsx" Then
strDBCONN = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPATH & ";Extended _
Properties='Excel 12.0 Xml;HDR=YES'"
'Debug.Print "xlsx"
ElseIf Right(DBPATH, 3) = "xls" Then
strDBCONN = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPATH & ";Extended _
Properties='Excel 8.0;HDR=YES'"
'Debug.Print "xls"
ElseIf Right(DBPATH, 4) = "xlsb" Then
strDBCONN = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPATH & ";Extended _
Properties='Excel 12.0;HDR=YES'"
'Debug.Print "xlsb"
ElseIf Right(DBPATH, 5) = "accdb" Then
strDBCONN = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPATH & ";Persist _
Security Info=False"
'Debug.Print "accdb"
End If
openDB = strDBCONN
End Function