Private intThisModuleOnly2 As Integer
Public intAllModules As Integer
Sub DebugListNames(pCol As Object)
' Prints the names of each object in the pCol collection
' in the debug window
Dim pObj As Object
For Each pObj In pCol
Debug.Print pObj.Name
Next
End Sub
Sub exaCreateAction()
' Creates an action query and executes it
Dim db As Database
Dim qdf As QueryDef
Dim strSQL As String
Set db = CurrentDb
' Create an SQL UPDATE statement
' to raise prices by 10%
strSQL = "UPDATE BOOKS SET Price = Price*1.1 WHERE Price > 20"
' Create a new QueryDef object
Set qdf = db.CreateQueryDef("riceInc", strSQL)
qdf.Execute
End Sub
Sub exaCreateAction2()
' Creates an action query and
' demonstrates transaction use
Dim ws As Workspace
Dim db As Database
Dim qdf As QueryDef
Dim strSQL As String
Set ws = DBEngine(0)
Set db = CurrentDb
' Create an SQL UPDATE statement
' to raise prices by 10%
strSQL = "UPDATE BOOKS SET Price = Price*1.1 WHERE Price > 20"
' Create a new QueryDef object
Set qdf = db.CreateQueryDef("riceInc", strSQL)
' Begin a transaction
ws.BeginTrans
' Execute the query
qdf.Execute
' Check the number of records effected and either rollback transaction or proceed
If qdf.RecordsAffected > 15 Then
MsgBox qdf.RecordsAffected & " records affected by this query. Transaction cancelled."
ws.Rollback
Else
MsgBox qdf.RecordsAffected & " records affected by this query. Transaction completed."
ws.CommitTrans
End If
End Sub
Sub exaCreateDb()
' Creates a new database named c:\temp\MoreBks.mdb
Dim dbNew As Database
Dim tbl As TableDef
Dim fld As Field
Set dbNew = CreateDatabase("c:\temp\MoreBks", dbLangGeneral)
For Each tbl In dbNew.TableDefs
Debug.Print tbl.Name
Next
dbNew.Close
End Sub
Sub exaCreateTable()
' Adds a new table to the current database
Dim db As Database
Dim tblNew As TableDef
Dim fld As Field
Set db = CurrentDb
Set tblNew = db.CreateTableDef("NewTable")
Set fld = tblNew.CreateField("NewField", dbText, 100)
' Set properties of field BEFORE appending
' zero length value is OK
fld.AllowZeroLength = True
' default value is 'Unknown'
fld.DefaultValue = "Unknown"
' Null value not allowed
fld.Required = True
' Validation
fld.ValidationRule = "Instr$(Like 'A*' or Like 'Unknown'"
fld.ValidationText = "Known value must begin with A"
' Append field to Fields collection
tblNew.Fields.Append fld
' Append table to TableDef collection
db.TableDefs.Append tblNew
' Creates an index named PriceTitle in the current db
Dim db As Database
Dim tdf As TableDef
Dim idx As Index
Dim fld As Field
Set db = CurrentDb
Set tdf = db.TableDefs!BOOKS
' Create index by the name of PriceTitle
Set idx = tdf.CreateIndex("riceTitle")
' Append the price and then the Title fields
' to the Fields collection of the index
Set fld = idx.CreateField("Price")
idx.Fields.Append fld
Set fld = idx.CreateField("Title")
idx.Fields.Append fld
' Append the index to the indexes collection for BOOKS
tdf.Indexes.Append idx
End Sub
Sub exaRecordsetAddNew()
' Add a new book to BOOKS
' Demonstrates With...End With construct
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
' Open recordset
Set rs = db.OpenRecordset("Books")
Debug.Print "Current title: " & rs!Title
' Use With...End With construct
With rs
.AddNew ' Add new record
!ISBN = "0-000" ' Set fields
!Title = "New Book"
!PubID = 1
!Price = 100
.Update ' Save changes.
.Bookmark = rs.LastModified ' Go to new record
Debug.Print "Current title: " & rs!Tit作者: neoen1 时间: 2002-8-14 00:10
没说明怎么看啦？累！作者: sdlhlsd 时间: 2002-8-14 02:43
代码很不错, 是否原作？作者: zglsky 时间: 2002-8-19 17:18
这例子代码有什么作用？作者: HG 时间: 2002-8-19 19:28
考古研究,珍寶呀。作者: NeilChen 时间: 2002-8-20 07:27
其实很多例子代码太繁琐了，如：
docmd.runsql ""UPDATE BOOKS SET Price = Price*1.1 WHERE Price > 20"
可以代替：
Sub exaCreateAction()
' Creates an action query and executes it
Dim db As Database
Dim qdf As QueryDef
Dim strSQL As String
Set db = CurrentDb
' Create an SQL UPDATE statement
' to raise prices by 10%
strSQL = "UPDATE BOOKS SET Price = Price*1.1 WHERE Price > 20"
' Create a new QueryDef object
Set qdf = db.CreateQueryDef("riceInc", strSQL)
riceInc", strSQL)