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,我把源程序发给你

解决方案 »

  1.   

    http://yujinzhao.myetang.com/VBcode/vbCode.htm
    “数据库”源代码里下载。
      

  2.   

    Dim dbCurDate As Database
      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