这个程序是照着书复制的,但编译的时候,还是有问题
系统提示红色的地方有问题,麻烦各位大侠帮忙,小弟不胜感激
Public Sub CreateDatabase() Dim NewWs As Workspace Set NewWs = DBEngine.Workspaces(0) Dim NewDb As Database Dim mdbName As String mdbName = CurDir() & "\SAMPLE\Authors.mdb" Set NewDb = NewWs.CreateDatabase(mdbName, dblangGeneral) Dim NewTbl1 As TableDef, NewTbl2 As TableDef Set NewTbl1 = NewDb.CreateTableDef("Youth") Set NewTbl2 = NewDb.CreateTableDef("Works") Dim F1 As Field, F2 As Field, F3 As Field, F4 As Field Dim F5 As Field, F6 As Field, F7 As Field, F8 As Field Dim F9 As Field, F10 As Field, F11 As Field Set F1 = NewTbl1.CreateField("AuthorID", dbText, 6) Set F2 = NewTbl1.CreateField("FirstName", dbText, 20) Set F3 = NewTbl1.CreateField("LastName", dbText, 20) Set F4 = NewTbl1.CreateField("Age", dbInteger) Set F5 = NewTbl1.CreateField("Address", dbText, 30) Set F6 = NewTbl1.CreateField("City", dbText, 20) Set F7 = NewTbl1.CreateField("Proviance", dbText, 20) Set F8 = NewTbl1.CreateField("Phone", dbText, 10) Set F9 = NewTbl1.CreateField("Email", dbText, 20) Set F10 = NewTbl2.CreateField("AuthorID", dbText, 6) Set F11 = NewTbl2.CreateField("WorksName", dbText, 30) NewTbl1.ValidationRule = "Age > 0" NewTbl1.ValidationText = "职员年龄不能小于零!"
NewTbl1.Fields.Append F1 NewTbl1.Fields.Append F2 NewTbl1.Fields.Append F3 NewTbl1.Fields.Append F4 NewTbl1.Fields.Append F5 NewTbl1.Fields.Append F6 NewTbl1.Fields.Append F7 NewTbl1.Fields.Append F8 NewTbl1.Fields.Append F9 NewTbl2.Fields.Append F10 NewTbl2.Fields.Append F11 NewDb.TableDefs.Append NewTbl1 NewDb.TableDefs.Append NewTbl2 NewDb.Close Set NewDb = Nothing
End Sub |