以前发过一个，刚学还有点问题，现在这个完善了一些，给同学们参考一下，希望有什么好的大家探讨一下啊！
有发现不合理或者好的建议请指点一下啊！
功能：
在已有表中保存新建字段，如果有相同字段就不保存，直接在字段下保存数据，如果该字段中已有相同值就不保存
Sub 保存()
On Error GoTo ErrH
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sql As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
    If cn.State = adStateOpen Then cn.Close
    If rs.State = adStateOpen Then rs.Close
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\AAA.mdb;Persist Security Info=False;Jet OLEDB:Database Password=1234;"
    sql = "select * from 表1"
    rs.Open sql, cn, 3, 3
’上面是查询数据库中的表1
    A = Combo2.Text'字段名
    B = Combo3.Text’字段中的值
'-----------------------------------------------------------
'先查询需要保存的字段是否存在，如果存在就查询该字段中是否已经有需要保存的值，有就退出，没有就继续执行下面一个
    For I = 0 To rs.Fields.Count - 1 '循环字段名
       If rs.Fields(I).Name = A Then '如果存字段名已存在，对比该字段下的数据中是否存在相同的值
          If rs.RecordCount > 0 Then'如果表中有记录就执行对比
             For L = 1 To rs.RecordCount '循环记录
                If Trim(rs.Fields(A)) = Trim(B) Then’如果有记录就关闭数据库退出
                   If cn.State = adStateOpen Then cn.Close
                   If rs.State = adStateOpen Then rs.Close
                   Exit Sub '如果存在就退出
                End If
             rs.MoveNext '移动到下一条记录进行对比
             Next
          End If
'-------------------------------------------------------------------
'在上面一段如果没有查询到该字段中有相同的值，那么在下面就再查询有没有空值，如果有空值就将数据保存到空值的那个单元格然后退出
          If rs.RecordCount > 0 Then '如果表中有记录就再次循环记录
              rs.MoveFirst'因为上面的循环用了 “rs.MoveNext ”已经不是默认的第一条记录了，所以先要你指定到第一条记录
             For L = 1 To rs.RecordCount
                If Trim(rs.Fields(A) & "") = "" Then '如果发现有空值
                   rs.Fields(A) = Trim(B) '将空值修改为combo3的值
                   rs.Update '修改保存
                   If cn.State = adStateOpen Then cn.Close
                   If rs.State = adStateOpen Then rs.Close
                   Exit Sub '退出
                End If
                rs.MoveNext '如果不是空值就移动到下一条记录
            Next
          End If
’--------------------------------------------------------------
'上面是否有空值查询完毕，但是没有查询到空值，所以只能直接新建一条记录，下面就是新建记录
          rs.AddNew '上面没有查询到空值就新建一个记录
          rs.Fields(A) = Trim(B)
          rs.Update’保存，这个不能少
          If cn.State = adStateOpen Then cn.Close
          If rs.State = adStateOpen Then rs.Close
          Exit Sub
       End If
    Next’这个next是最上面那个For的别看错了
’--------------------------------------------------------
’在上面的查询中如果没有查询到需要保存的字段名，那么下面就开始新建一个字段
     If rs.State = adStateOpen Then rs.Close '如果打开了表，就先关闭
      sql = "ALTER TABLE 表一 ADD COLUMN [" & Combo2.Text & "] text"
 '新建字段 []  加中括号是因为有时候字段名中会存在特殊字符，比如：-+*‘’“”等，不加可能会报错，这个是版主：风吹过b  教我的
      cn.Execute sql '保存新建字段
     '-----------------------------------------------------
'新建号字段后要重新刷新一下RS的记录，因为新建的字段没在rs中
     sql = "select * from 表1"
     rs.Open sql, , 3, 3
     If rs.RecordCount > 0 Then '如果表中有记录就循环记录，目的是查看有没有空值
             rs.MoveFirst '因为上面已经把指针移动到最后一条记录，所以要执行下面的循环先要把指针移动到第一条记录，要不然会出错
             Do While Not rs.EOF '循环记录集，查询是否有空值,Not rs.EOF表示循环到最后一条记录
                If Trim(rs.Fields(A) & "") = "" Then '如果发现有空值
                   rs.Fields(A) = Trim(B) '将空值修改为combo3的值
                   rs.Update '修改保存
                   If cn.State = adStateOpen Then cn.Close
                   If rs.State = adStateOpen Then rs.Close
                   Exit Sub '退出
                End If
                rs.MoveNext
             Loop
      End If
     rs.AddNew '上面没有查询到空值就新建一个记录
     rs.Fields(A) = Trim(B)
     rs.Update
    If cn.State = adStateOpen Then cn.Close
    If rs.State = adStateOpen Then rs.Close
    Exit Sub
ErrH:
   MsgBox "记录新数据错误，请及时与管理员联系！", 48, "提示"
End Sub

[ 本帖最后由 wxflw 于 2013-6-23 06:31 编辑 ]

收到的鲜花

• Artless 于 2013-06-24 12:00 送鲜花  5朵   附言：好文章

顶楼主！

谢谢共享，学习一下！