一些例子

Y.J.Wang

Option Compare Database
Option Explicit

Dim intThisModuleOnly As Integer

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

End Sub


Sub exaDoLoop()

' Demonstrates Do loop

Dim intCounter As Integer
Dim intSum As Integer

intSum = 0
Do While intCounter < 10

    intCounter = intCounter + 1
    intSum = intSum + intCounter
   
Loop

MsgBox str(intSum)

End Sub

Sub exaCreateIndex()

' 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

没说明怎么看啦？累！

sdlhlsd

代码很不错, 是否原作？

zglsky

这例子代码有什么作用？

HG

考古研究,珍寶呀。

NeilChen

其实很多例子代码太繁琐了，如：
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)

qdf.Execute

End Sub

zglsky

看来看去都看不懂,请可以的话上传个MDB文件教教小弟.......]