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