下面是模块中的代码
Public Function ExecuteSQL(ByVal SQL As String) As ADODB.Recordset
    Dim cnn As New ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim sTokens() As String
   
On Error GoTo Error_Do

    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data.mdb;Persist Security Info=False"
    sTokens() = Split(SQL)
   
    If InStr("INSERT,DELETE,UPDATE", UCase(sTokens(0))) Then
        cnn.Execute SQL
    Else
        Set rst = New ADODB.Recordset
        
        With rst
            .ActiveConnection = cnn
            .CursorLocation = adUseClient
            .CursorType = adOpenStatic
            .LockType = adLockOptimistic
            .Open Trim(SQL)
        End With
        'rst.Open Trim(SQL), cnn, adOpenStatic, adLockOptimistic
        Set ExecuteSQL = rst
    End If
   
    Set cnn = Nothing
    Set rst = Nothing
    Exit Function
Error_Do:
    Dim Err_Str As String
    Err_Str = "服务器" & Err.Description
    If MsgBox(Err_Str, vbRetryCancel + vbCritical, "警告") = vbRetry Then
        Resume
    Else
        Set cnn = Nothing
        Set rst = Nothing
        End
    End If
End Function


下面是向数据库中增加记录的代码

Private Sub Command1_Click(Index As Integer)

   
    Dim mrc As ADODB.Recordset
    Dim txtSQL As String
  
    '

  
    '查询该记录是否存在
  
    Set mrc = ExecuteSQL(txtSQL)
   
    mrc.AddNew
    mrc.Fields(0) = Trim(Text1(0).Text)
    mrc.Fields(1) = Trim(Text1(1).Text)
  
    mrc.Fields(2) = Trim(Text1(2).Text)
   
    mrc.Fields(3) = Trim(Text1(3).Text)
    mrc.Fields(4) = Trim(Text1(4).Text)
   
   
   
    mrc.Update
    mrc.Close
    MsgBox "记录添加成功！", vbOKOnly + vbExclamation, "电子通讯录-提示"
   
  
    Text1(0).SetFocus
    Text1(0).Text = ""
    Text1(1).Text = ""
    Text1(2).Text = ""
    Text1(3).Text = ""
    Text1(4).Text = ""
  
End Sub

为什么总是提示“服务器下标越界”啊