Create DB and Table using ADO...

[agentleong]

Hi there,
I'm a newbie in VB, I need to create a simple database with some table using ADO without using control.
Anyone who knows or has the sample code, please kindly share it..

------------------------------------------------------------

Public Sub createDB()
Dim ADOConnection As New ADODB.Connection
On Error GoTo ErrorHandler
' Create a new database called JetStoredProcedure.mdb
'ADODB.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & DBPath

' Set the Connection Properties and open the connection.
With ADOConnection
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open "Data Source=" & App.Path & DBPath
'Create a new table
.Execute "Create Table tblInvoice(InvNo text(50), InvDate Date, pathFileName text(128))"
End With
' Clean up

ADOConnection.Close
Set ADOConnection = Nothing
Exit Sub
ErrorHandler:
If Err = 53 Then
Resume Next
End If
MsgBox Error & " Error# " & Err
Exit Sub
End Sub

-----------------------------------------------------------
Thanks a lot,
AL

[Edneeis]

Here is some code to get you started. It makes a new database and a table that has an index and what not.

Dim newdb As Database
Set newdb = CreateDatabase(PathandNameOfNewDB, dbLangGeneral)
'make agencies table
Dim tbAgn As TableDef
Dim IndAgn As Index
Set tbAgn = newdb.CreateTableDef("Agencies")
tbAgn.Indexes.Refresh
tbAgn.Fields.Append tbAgn.CreateField("db_ID", dbLong, 4)
tbAgn.Fields(0).Attributes = dbAutoIncrField
tbAgn.Fields.Append tbAgn.CreateField("Agency", dbText, 50)
tbAgn.Fields.Append tbAgn.CreateField("Path", dbMemo)
tbAgn.Fields.Append tbAgn.CreateField("Access", dbInteger, 2)
tbAgn.Fields.Append tbAgn.CreateField("Notes", dbMemo)
Set IndAgn = tbAgn.CreateIndex("db_ID")
IndAgn.Name = "db_Index"
IndAgn.Primary = True
IndAgn.Fields.Append IndAgn.CreateField("db_ID", dbLong, 4)
tbAgn.Indexes.Append IndAgn
newdb.TableDefs.Append tbAgn

[Chris]

Yo! Agent, here the sample code for creating a database and table using the Microsoft ADO Ext. 2.1 for DDl and Security (ADOX).


Public Function CREATE_DATABASE(ByVal lpPath As String, ByVal lpDBName As String, Optional ByVal lpPassword As String = "") As Long
On Error GoTo ErrHandle

If lpDBName = "" Then GoTo ErrHandle
If lpPath = "" Then lpPath = App.Path
lpPassword = Chr(34) & lpPassword & Chr(34)

Set cat = New ADOX.Catalog
cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=" & lpPassword & ";Data Source=" & lpPath & lpDBName
Set cat = Nothing
CREATE_DATABASE = 1

Exit Function
ErrHandle:
'Err.Raise Err, "CREATE_DATABASE", Error
MsgBox "Error :" & Err.Number & " " & Err.Description, vbExclamation + vbOKOnly, "DbKits"
CREATE_DATABASE = 0
Set cat = Nothing

End Function

Public Function CREATE_TABLE(ByVal lpPath As String, ByVal lpDBName As String, ByVal lptblName As String, Optional ByVal lpPassword As String = "") As Long
On Error GoTo ErrHandle
Dim i As Integer
Set cat = New ADOX.Catalog
Set tbl = New ADOX.Table

lpPassword = Chr(34) & lpPassword & Chr(34)
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Password=" & lpPassword & ";Data Source=" & lpPath & lpDBName
tbl.Name = lptblName

'Append all the new fields
tbl.Columns.Append "InvNo", adWChar, 50
tbl.Columns.Append "InvDate", adDate
tbl.Columns.Append "pathFileName", adWChar, 128
cat.Tables.Append tbl

Set tbl = Nothing
Set cat = Nothing

CREATE_TABLE = 1
Exit Function
ErrHandle:
'Err.Raise Err, "CREATE_TABLE", Error
MsgBox "Error :" & Err.Number & " " & Err.Description, vbExclamation + vbOKOnly, "DbKits"
CREATE_TABLE = 0
Set cat = Nothing

End Function

[agentleong]

thanks guys...