I found sample code from the VBA Access help for a module CreateTableDefX

Public Const db_File = "My_db"
Sub CreateMydb()

Dim MyCatalog As New ADOX.Catalog
FullName = ThisWorkbook.Path & "\" & db_File & ".mdb"
FName = Dir(FullName)
If FName < "" Then
Kill FullName
End If

MyCatalog.ActiveConnection = CurrentProject.Connection

Set tbl = New ADOX.Table
tbl.Name = "Contacts"

With tbl.Columns
.Append "FullName", adVarChar, 20
.Append "Data Source", adVarChar, 20
End With

Set cmd = New ADODB.Command
With cmd
.CommandText = "Mycontact"
.CommandType = adCmdUnknown

.Parameters.Append .CreateParameter( _
"Fullname", adVarChar, adParamInput, 20)

.Parameters.Append .CreateParameter( _
"Data Source", adVarChar, adParamInput, 20)
End With
End Sub


Access code
-----------------------------------------------------------------

Sub CreateTableDefX()

Dim dbsNorthwind As Database
Dim tdfNew As TableDef
Dim prpLoop As Property

Set dbsNorthwind = OpenDatabase("Northwind.mdb")

' Create a new TableDef object.
Set tdfNew = dbsNorthwind.CreateTableDef("Contacts")

With tdfNew
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' Northwind database.
.Fields.Append .CreateField("FirstName", dbText)
.Fields.Append .CreateField("LastName", dbText)
.Fields.Append .CreateField("Phone", dbText)
.Fields.Append .CreateField("Notes", dbMemo)

Debug.Print "Properties of new TableDef object " & _
"before appending to collection:"

' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop < "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop

' Append the new TableDef object to the Northwind
' database.
dbsNorthwind.TableDefs.Append tdfNew

Debug.Print "Properties of new TableDef object " & _
"after appending to collection:"

' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop < "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop

End With

' Delete new TableDef object since this is a
' demonstration.
dbsNorthwind.TableDefs.Delete "Contacts"

dbsNorthwind.Close

End Sub




"Jon" wrote:

Greeting,

I have the following code for creating mdb by clicking on button in workbook
sheet. The code is working fine but the problem is the mdb format is 2000 and
I need it to be 2003 format? Any suggestion please??

Public Const db_File = "My_db"
Sub CreateMydb()
Dim MyCatalog As New ADOX.Catalog
FullName = ThisWorkbook.Path & "\" & db_File & ".mdb"
On Error Resume Next
Kill FullName
On Error GoTo 0
MyConct = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & FullName &
";"
MyCatalog.Create MyConct & ";Data Source = " & FullName
End Sub