MSDN中的源程序:
控件:
dlgFind CommonDialog
FrmCtlCfg Form
GrdControls DataGrid_______________________
Option ExplicitDim rsControls As New ADODB.Recordset
Dim cnControls As New ADODB.ConnectionPrivate Sub Form_Load()
On Error GoTo FindErr
Dim strQ As String
strQ = "provider=Microsoft.Jet.OLEDB.3.51;data source=" & App.Path & "\controls.mdb"
cnControls.Open strQ
rsControls.Open "select * from controls order by description", cnControls, adOpenKeyset, adLockOptimistic
Set grdControls.DataSource = rsControls
Exit Sub
FindErr:
' If the database isn't found, use the FindDB function to find it.
If Err.Number = -2147467259 Then
cnControls.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data source=" & FindDB("controls.mdb")
Resume Next
End If
Exit Sub
End SubPrivate Function FindDB(dbName As String) As String
On Error GoTo ErrHandler ' Configure cmdDialog in case the database can't be found.
With dlgFind
.DialogTitle = "Can't Find " & dbName
.Filter = "(*.MDB)|*.mdb"
.CancelError = True 'Causes an error if user clicks on cancel
.ShowOpen
End With
' Test the string to ensure it's the sought database.
Do While Right(Trim(dlgFind.FileName), Len(dbName)) <> dbName
MsgBox "File Name is not equal to " & dbName
dlgFind.ShowOpen
Loop
FindDB = dlgFind.FileName ' return the full path.
Exit Function
ErrHandler:
Select Case Err.Number
Case 32755
Unload Me
Case Else
MsgBox Err.Number & ": " & Err.Description
End SelectEnd FunctionPrivate Sub Form_Resize()
lblInfo.Width = ScaleWidth
grdControls.Move 0, lblInfo.Height, ScaleWidth, ScaleHeight - lblInfo.Height
End SubPrivate Sub grdControls_Error(ByVal DataError As Integer, Response As Integer)
Response = 0
End SubPrivate Sub mnuDeleteEntry_Click()
rsControls.Delete
End SubPrivate Sub mnuExit_Click()
Unload Me
End SubPrivate Sub mnuNewEntry_Click()
rsControls.AddNew
End SubPrivate Sub mnuSave_Click()
Dim vControlLicense As Variant
Dim sControlType As String
On Error Resume Next
rsControls.MoveFirst
While Not rsControls.EOF
vControlLicense = Null
sControlType = rsControls.Fields("ControlType")
vControlLicense = Licenses.Add(sControlType)
Licenses.Remove sControlType
rsControls.Fields("ControlLicense") = vControlLicense
rsControls.MoveNext
Wend rsControls.Update
rsControls.MoveFirst
End Sub你留下Email,我把源程序发给你
控件:
dlgFind CommonDialog
FrmCtlCfg Form
GrdControls DataGrid_______________________
Option ExplicitDim rsControls As New ADODB.Recordset
Dim cnControls As New ADODB.ConnectionPrivate Sub Form_Load()
On Error GoTo FindErr
Dim strQ As String
strQ = "provider=Microsoft.Jet.OLEDB.3.51;data source=" & App.Path & "\controls.mdb"
cnControls.Open strQ
rsControls.Open "select * from controls order by description", cnControls, adOpenKeyset, adLockOptimistic
Set grdControls.DataSource = rsControls
Exit Sub
FindErr:
' If the database isn't found, use the FindDB function to find it.
If Err.Number = -2147467259 Then
cnControls.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data source=" & FindDB("controls.mdb")
Resume Next
End If
Exit Sub
End SubPrivate Function FindDB(dbName As String) As String
On Error GoTo ErrHandler ' Configure cmdDialog in case the database can't be found.
With dlgFind
.DialogTitle = "Can't Find " & dbName
.Filter = "(*.MDB)|*.mdb"
.CancelError = True 'Causes an error if user clicks on cancel
.ShowOpen
End With
' Test the string to ensure it's the sought database.
Do While Right(Trim(dlgFind.FileName), Len(dbName)) <> dbName
MsgBox "File Name is not equal to " & dbName
dlgFind.ShowOpen
Loop
FindDB = dlgFind.FileName ' return the full path.
Exit Function
ErrHandler:
Select Case Err.Number
Case 32755
Unload Me
Case Else
MsgBox Err.Number & ": " & Err.Description
End SelectEnd FunctionPrivate Sub Form_Resize()
lblInfo.Width = ScaleWidth
grdControls.Move 0, lblInfo.Height, ScaleWidth, ScaleHeight - lblInfo.Height
End SubPrivate Sub grdControls_Error(ByVal DataError As Integer, Response As Integer)
Response = 0
End SubPrivate Sub mnuDeleteEntry_Click()
rsControls.Delete
End SubPrivate Sub mnuExit_Click()
Unload Me
End SubPrivate Sub mnuNewEntry_Click()
rsControls.AddNew
End SubPrivate Sub mnuSave_Click()
Dim vControlLicense As Variant
Dim sControlType As String
On Error Resume Next
rsControls.MoveFirst
While Not rsControls.EOF
vControlLicense = Null
sControlType = rsControls.Fields("ControlType")
vControlLicense = Licenses.Add(sControlType)
Licenses.Remove sControlType
rsControls.Fields("ControlLicense") = vControlLicense
rsControls.MoveNext
Wend rsControls.Update
rsControls.MoveFirst
End Sub你留下Email,我把源程序发给你
“数据库”源代码里下载。
Dim recCurDate As Recordset
Set dbCurDate = OpenDatabase(Databs)
sqlStr = "SELECT * FROM DtTable " & _
"WHERE Date=#" & strLoadDate & "#"
Set recCurDate = dbCurDate.OpenRecordset(sqlStr, dbOpenSnapshot)
......
recCurDate.Close
dbCurDate.Close