'添加按钮
Private Sub ComTj_Click()Dim DriverSex As Integer
Dim rsAdd As New ADODB.Recordset
Dim sqlstr As String
Dim strConn  As String
Dim Re As String    '首先检验输入
    '没有输入住户姓名
    If Len(Trim(Me.TextName.Text)) <= 0 Then
        MsgBox "请输入住户姓名!", , "添加住户档案"
        Exit Sub
    End If
    '输入司机姓名不正确
    If Len(Trim(Me.TextName.Text)) < 2 Or Len(Trim(Me.TextName.Text)) > 8 Then
        MsgBox "输入住户姓名不正确!", , "添加住户档案"
        Exit Sub
    End If
    
    '没有输入住户ID
    If Len(Trim(Me.TextID.Text)) <= 0 Then
        MsgBox "请输入6位住户ID!", , "添加住户档案"
        Exit Sub
    End If
    '输入住户ID不正确
    If Len(Trim(Me.TextID.Text)) <> 6 Then
        MsgBox "住户ID不正确,请输入6位住户ID!", , "添加住户档案"
        Exit Sub
    End If
   
    '没有选择住户性别
    If Me.TextSex.Text = "" Then
        MsgBox "请输入住户性别!", , "添加住户档案"
        Exit Sub
    End If
    
    '没有输入住户工作单位
    If Len(Trim(Me.TextDw.Text)) <= 0 Then
        MsgBox "请输入住户工作单位!", , "添加住户档案"
        Exit Sub
    End If
    
    
    '没有输入住户楼号
    If Len(Trim(Me.TextNum.Text)) <= 0 Then
        MsgBox "请输入住户楼号!", , "添加住户档案"
        Exit Sub
    End If
  
    
    '没有输入住户单元
    If Len(Trim(Me.TextUnit.Text)) <= 0 Then
        MsgBox "请输入住户单元!", , "添加住户档案"
        Exit Sub
    End If
    
    '没有输入住户楼层
    If Len(Trim(Me.TextLc.Text)) <= 0 Then
        MsgBox "请输入住户楼层!", , "添加住户档案"
        Exit Sub
    End If
        strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Password=;Data Source="
    strConn = strConn & App.Path & "\db1.mdb" & ";Persist Security Info=True"
    rsAdd.Open strConn     '备注项可选
    If Me.TextRe.Text = vbNullString Then '没有备注项
        sqlstr = "INSERT INTO 户主信息"
        sqlstr = sqlstr & "(卡号,姓名,性别,性别,工作单位/学校,"
        sqlstr = sqlstr & "楼号,单元,楼层,) "
        sqlstr = sqlstr & "VALUES ('" & Me.TextID.Text & "',"
        sqlstr = sqlstr & "'" & Me.TextName.Text & "',"
        sqlstr = sqlstr & TextSex & ","
        sqlstr = sqlstr & "#" & Me.DTPicker1.Value & "#,"
        sqlstr = sqlstr & Me.TextDw.Text & ","
        sqlstr = sqlstr & "'" & Me.TextNum.Text & "',"
        sqlstr = sqlstr & "'" & Me.TextUnit.Text & "',"
        sqlstr = sqlstr & "'" & Me.TextLc.Text & "');"
       
        Debug.Print sqlstr
        DBCn.Execute sqlstr
        
    Else    '有备注项
        Re = Replace(Trim(Me.TextRe.Text), "'", "''")
        sqlstr = "INSERT INTO 户主信息"
        sqlstr = sqlstr & "(卡号,姓名,性别,性别,工作单位/学校,"
        sqlstr = sqlstr & "楼号,单元,楼层,"
        sqlstr = sqlstr & "备注) "
        sqlstr = sqlstr & "VALUES ('" & Me.TextID.Text & "',"
        sqlstr = sqlstr & "'" & Me.TextName.Text & "',"
        sqlstr = sqlstr & TextSex & ","
        sqlstr = sqlstr & "#" & Me.DTPicker1.Value & "#,"
        sqlstr = sqlstr & Me.TextDw.Text & ","
        sqlstr = sqlstr & "'" & Me.TextNum.Text & "',"
        sqlstr = sqlstr & "'" & Me.TextUnit.Text & "',"
        sqlstr = sqlstr & "'" & Me.TextLc.Text & "',"
       
        sqlstr = sqlstr & "'" & Re & "');"
        Debug.Print sqlstr
        DBCn.Execute sqlstr
  
  End If
      MsgBox "添加成功", , "添加住户档案"
    Adodc1.RefreshEnd Sub

解决方案 »

  1.   

    什么问题?报什么错?错误描述是什么?在哪一行报错?
    这些你都不说,怎么帮你?
    ------------------------------------------
    边猜边说吧:))
    1):你声明了Dim   rsAdd   As   New   ADODB.Recordset 后来怎么又:
      strConn="Provider=Microsoft.Jet.OLEDB.4.0;Password=;Data Source= " 
      strConn=strConn & App.Path & "\db1.mdb" &";PersistSecurityInfo=True" 
      rsAdd.Open   strConn 了呢?
      定义了记录集,却作为数据库连接打开,能不出错吗?2)
      Debug.Print sqlstr 
      DBCn.Execute   sqlstr 
      这个DBCn数据库连接是怎么来的?在哪里声明的,又是怎么打开的呢?3)没有经过任何错误判断,就直接给出 MsgBox "添加成功 ", ,"添加住户档案"的提示,是不是有点掩耳盗铃的味道呢?呵呵,楼主真马虎~
      

  2.   

    帮你整理了一下,你测试一下吧
    -----------------------------------Private Sub ComTj_Click()Dim DriverSex%
    ''''''''''''''Dim   rsAdd   As   New   ADODB.Recordset
    Dim DBCn As New adodb.connection
    Dim sqlStr$, strConn$, Re$, t$
     
      t = "添加住户档案"  '首先检验输入
      
      If Len(Trim(TextName)) <= 0 Then '没有输入住户姓名
        MsgBox "请输入住户姓名! ", 48, t:  Exit Sub
      ElseIf Len(Trim(TextName)) < 2 Or Len(Trim(TextName)) > 8 Then '输入司机姓名不正确(TextName怎么既代表住户姓名又代表司机姓名??)
        MsgBox "输入住户姓名不正确! ", 48, t:  Exit Sub
      ElseIf Len(Trim(TextID)) <= 0 Then '没有输入住户ID
        MsgBox "请输入6位住户ID! ", 48, t:  Exit Sub
      ElseIf Len(Trim(TextID)) <> 6 Then '输入住户ID不正确
        MsgBox "住户ID不正确,请输入6位住户ID! ", 48, t:  Exit Sub
      ElseIf TextSex = " " Then '没有选择住户性别
        MsgBox "请输入住户性别! ", 48, t:  Exit Sub
      ElseIf Len(Trim(TextDw)) <= 0 Then '没有输入住户工作单位
        MsgBox "请输入住户工作单位! ", 48, t:  Exit Sub
      ElseIf Len(Trim(TextNum)) <= 0 Then '没有输入住户楼号
        MsgBox "请输入住户楼号! ", 48, t:  Exit Sub
      ElseIf Len(Trim(TextUnit)) <= 0 Then '没有输入住户单元
        MsgBox "请输入住户单元! ", 48, t:  Exit Sub
      ElseIf Len(Trim(TextLc)) <= 0 Then '没有输入住户楼层
        MsgBox "请输入住户楼层! ", 48, t:  Exit Sub
      End If
      
      '数据库连接
      On Error Resume Next
      
      strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Password=;Data   Source= "
      strConn = strConn & App.Path & "\db1.mdb " & ";Persist   Security   Info=True "
      DBCn.Open strConn
      If DBCn.state <> 1 Then
        MsgBox "数据库连接失败!请检查连接字符串。具体原因:" & Err.Description, vbCritical, "提示"
        Exit Sub
      End If
      
      On Error GoTo vbError_Handler:
      
      '备注项可选
      If TextRe = vbNullString Or Len(TextRe) = 0 Then       '没有备注项
        sqlStr = "INSERT INTO 户主信息 (卡号,姓名,性别,性别,工作单位/学校,楼号,单元,楼层) "
        sqlStr = sqlStr & "VALUES ('" & TextID & "',"
        sqlStr = sqlStr & "'" & TextNaText & "',"
        sqlStr = sqlStr & TextSex & ","
        sqlStr = sqlStr & "# " & DTPicker1.Value & "#,"
        sqlStr = sqlStr & TextDw & ","
        sqlStr = sqlStr & "'" & TextNum & "',"
        sqlStr = sqlStr & "'" & TextUnit & "',"
        sqlStr = sqlStr & "'" & TextLc & "')"
      
      Else         '有备注项
        Re = Replace(Trim(TextRe), "'", "‘")
        sqlStr = "INSERT INTO 户主信息 (卡号,姓名,性别,性别,工作单位/学校,楼号,单元,楼层,备注) "
        sqlStr = sqlStr & "VALUES ('" & TextID & "',"
        sqlStr = sqlStr & "'" & TextName & "',"
        sqlStr = sqlStr & TextSex & ","
        sqlStr = sqlStr & "#" & DTPicker1.Value & "#,"
        sqlStr = sqlStr & TextDw & ","
        sqlStr = sqlStr & "'" & TextNum & "',"
        sqlStr = sqlStr & "'" & TextUnit & "',"
        sqlStr = sqlStr & "'" & TextLc & "',"
        sqlStr = sqlStr & "'" & Re & "'); "
      End If
    Debug.Print sqlStr
      DBCn.Execute sqlStr
      MsgBox "添加成功 ", 64, t
      Adodc1.Refresh
      Exit Sub
      
    vbError_Handler:
      MsgBox "添加失败!原因:" & Err.Description, 48, t
      Err.Clear
    End Sub