Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

creating an access table via Visual Basic

Status
Not open for further replies.

kah0563

Programmer
Feb 7, 2005
6
US
Is there any code examples that might help me create a table in an existing Access dbase? I found some that illustrated declaring variable as New TableDef, but that doesn't seem to be working? Any code to review here? Thanks
 
Hi
I hope it will answer your Question.
regards
Chris


'Datebase Connection to a MS Access mdb file
' with the current Username on my current Application path

Public Sub InitAppDB()
g_strAppDB = App.Path & "\" & GetCurrentUserName & ".mdb"
If Dir(g_strAppDB) = "" Then
If CreateDB(g_strAppDB) Then
Set g_objAppDB = DBEngine.Workspaces(0).OpenDatabase(g_strAppDB, False, False)
End If
Else
Set g_objAppDB = DBEngine.Workspaces(0).OpenDatabase(g_strAppDB, False, False)
End If
End Sub

'create Table with name: FileSetup and the Fields of ID, FileGroup, 'FileCatalog

Public Sub CreateFileSetupTable()
Dim TD As DAO.TableDef
Dim FLD As DAO.Field

Set TD = g_objAppDB.CreateTableDef("FileSetup")

Set FLD = TD.CreateField("ID")
FLD.Type = dbLong
FLD.Attributes = dbAutoIncrField
TD.Fields.Append FLD

Set FLD = TD.CreateField("FileGroup")
FLD.Type = dbText
FLD.AllowZeroLength = False
FLD.DefaultValue = "Nothing"
FLD.Size = 50
TD.Fields.Append FLD

Set FLD = TD.CreateField("FileCatalog")
FLD.Type = dbText
FLD.AllowZeroLength = False
FLD.DefaultValue = "Nothing"
FLD.Size = 50
TD.Fields.Append FLD

g_objAppDB.TableDefs.Append TD

End Sub


'Create a new File and delete the old if it exist

Public Function CreateDB(strAppDB_FullPath As String) As Boolean
Dim res As Integer

If Dir(strAppDB_FullPath) <> "" Then
res = MsgBox(strAppDB_FullPath & vbCrLf & "already exists. Replace this file?", vbQuestion + vbYesNoCancel, "Replace Database")
If res = vbYes Then
Kill strAppDB_FullPath
Else
CreateDB = False
Exit Function
End If
End If

Set g_objAppDB = DBEngine.Workspaces(0).CreateDatabase(strAppDB_FullPath, dbLangGeneral, dbVersion30)
g_objAppDB.Close
CreateDB = True
End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top