控件命名用前缀+字段
数据和文本用text 比如txtID,txtRes,日期我用msk 就是mskAuditDate之类的'*************************************************************************
'**函 数 名:recInSert
'**输    入:rs(ADODB.Recordset)                         -一个记录集,使用的时候只要传入一个空记录集即可,
'**                                                       也即 dim rs as new adodb.recorderset 之后,把此rs传入即可
'**          blnNew(Boolean)                             -新建的标志,如果是新建就是true,否则是false,保存成功之后此标志自动变成false
'**        :ByVal strTab(String)                        -表名
'**        :ByVal strUpdateSQL(String)                  -SQL语句
'**        :ByVal Frm(Form)                             -窗体
'**        :Optional strPrefix(String = "")             -字段前缀的匹配项,默认是空,此值一般不需要填入,当窗体上控件比较多的时候,此值也可以填入,
'**                                                       提高搜索界面的速度,例如有一张表,它的字段前缀都是 MR_lot_xxxx,此时在这个地方填入
'**                                                       "MR_lot"则搜索界面上的控件的时候,包含了此字符串"MR_lot"的控件才在搜索范围之内,不包含此前缀的
'**                                                        控件,即使是text,maskbox,也不会被搜索到'**        :Optional intPrefixPos(Integer = 4)          -从什么地方开始查找字段名,默认是4,此值基本上不改动。这个值的意思就是,如果你的控件都是按照标准来命名的
'**                                                       如:txtMR_lot_number,mskMR_lot_date, 则取字段名的时候从第四个值开始,即去掉前面的txt或者是msk来查找,
'**                                                       如果认为确实有必要,则可以填5,6,7等等,只要不超过控件名字总长度就可以
'**                                                       程序里面调用了 InStr(intPrefixPos, 控件名, strPrefix)来进行匹配
'**        :Optional intMidPos(Integer = 4)             -取字段名的位置,意思同上面查不多,去字段名,最后作为保存的依据
'**                                                       程序用的 mid(控件名字, intMidPos)来取字段名'**        :Optional varField(Variant = "")             -界面上不能处理的字段名(主要是cbo的下拉形式的,存入的是编码,显示的是名字)
'**        :Optional varValue(Variant)                  -不能反应的字段的值,和上面的字段名11对应
'**        :Optional NumberToNullOrZero(Boolean = True) - 是否把数值型的空值转换成0,默认为true
'**        :Optional blnSearchForm(Boolean = True)      -是否搜索界面,默认是true,如果不搜索界面,把表里面的所有字段都填入上面的varField
'**                                                       而把所有的对应值都填入了varValue则此处可以填false,不去搜索界面
'**        :Optional Cnn (ADODB.Connection)             -是否需要一个新的ado连接对象,如果需要的话传入,否则用全局对象cn即可
'**输    出:(Integer) - 新建成功返回1,保存成功返回2,保存失败返回0
'**功能描述:此函数在做事务的时候用,也就是如果界面上需要操作多张表,则有一个事务的启动和结束,在之间保存表的时候可以用多次 recInSert即可,此时需要注意
'**          每次调用完此函数 blnNew 都会变成false,所以如果每张表都是新建的时候,这个变量每次都要传入true
'**全局变量:
'**调用模块:
'**作    者:yubing
'**日    期:
'**修 改 人:
'**日    期:2004年07月26日
'**版    本:V1.0
'*************************************************************************

解决方案 »

  1.   

    Public Function recInSert(rs As ADODB.Recordset, blnNew As Boolean, ByVal strTab As String, ByVal strUpdateSQL As String, _
                              ByVal Frm As Form, Optional strPrefix As String = "", Optional intPrefixPos As Integer = 4, _
                              Optional intMidPos As Integer = 4, Optional varField As Variant = "", Optional varValue As Variant, _
                              Optional NumberToNullOrZero As Boolean = True, Optional blnSearchForm As Boolean = True, _
                              Optional Cnn As ADODB.Connection) As Integer'添加记录和修改记录,此函数在做事务用到,一般保存不用,而用recSave2 函数
    'blnNew : 新建还是修改 blnNew=True时新建,false 时修改
    'strTab :新建时用的表名
    'strUpdateSQL :修改时用到的查询语句,此查询语句的字段名不要具体列出
    'Frm :窗体名
    'strPrefix :要找寻的字段的前缀
    'intPrefixPos :开始找寻字段的的开始位置
    'intMidPos :要截取字段的位置
    'varField :一些界面不能反映出来的字段
    'varValue :界面不能反映的字段对应的值
    'varField 与 varValue 一定要一一对应
    'blnSearchForm :是否搜寻界面,true 时 搜寻界面,false时不搜寻界面'返回值 :保存不成功返回0。新建时保存成功返回1,修改时保存成功返回2
     
    Dim cntControl      As Control
    Dim i               As Integer
    Dim intPre          As Integer
    Dim strSQL          As String
    Dim strFieldName    As String
    Dim strAllFieldName As String
    Dim intType         As Integer '字段的类型
    Dim blnTrans        As Boolean '是否已经开始了一个事务'如果
    If Cnn Is Nothing Then Set Cnn = cn ''如果没有传入数据库连接对象,则默认使用全局的cn作为连接对象recInSert = 0If blnNew Then
        strSQL = "Select Top 1 * From " & strTab ''如果是新建就要选出一条,作为提交记录的基础
    Else
        '修改时如果Sql语句为空则退出
        If strUpdateSQL = "" Then Exit Function
     
        strSQL = strUpdateSQL ''修改的话必须有sql语句才行
    End If'如果没有查询语句则退出
    If strSQL = "" Then Exit Function ''此句可不要,在上面已经判断了为sql为空的时候退出If rs.state = adStateOpen Then rs.Close ''如果记录集是打开的则先关闭rs.Open strSQL, Cnn, adOpenStatic, adLockOptimistic, adCmdText ''打开记录集,参数用到了 adLockOptimistic 直到调用了update后才解除锁定'这里开始启动一个事务,如果先前已启动一个事务,这里就会发生错误,所以就next
    '此时的blnTrans=False'On Error Resume Next
    '
    'cn.BeginTrans
    '
    'If cn.Errors.Count > 0 Then
    '   blnTrans = False
    '   '然后把错误归为0
    '   On Error GoTo 0
    'Else
    '   blnTrans = True
    'End IfIf blnNew = False And rs.EOF Then ''如果此时时修改,但是记录又不存在,就退出
    '修改时找不到记录则添加
    '     rs.AddNew
        rs.Close
        Exit Function
    ElseIf blnNew Then
        rs.AddNew
    End If'连接出所有的字段,以便于查找,名字后的空格一定要有,不可去掉
    For i = 0 To rs.Fields.Count - 1
       strAllFieldName = strAllFieldName & ConSpace & LCase(rs.Fields(i).Name) & ConSpace ''拼接所有的字段名,形成 (字段名1 字段名2 字段名3 ……)这种格式
    Next i'可以没有前缀     '如果字段对应的值为空则付null
    intPre = Len(strPrefix) ''取得前缀的长度'On Error Resume NextIf blnSearchForm Then ''如果是要搜索界面的        For Each cntControl In Frm.Controls ''遍历界面上所有的控件
                   
                  '只处理文本框和日期框
                  If TypeOf cntControl Is MaskEdBox Or TypeOf cntControl Is TextBox Then ''如果是text或者是msk
                   
                        If (intPre > 0 And InStr(intPrefixPos, LCase(cntControl.Name), LCase(strPrefix)) > 0) Or intPre = 0 Then ''此处即判断字符搜索的位置,如果填入
                                                                                                                                 ''前缀,则前一个条件(intPre > 0 And InStr(intPrefixPos, LCase(cntControl.Name), LCase(strPrefix)) > 0)
                                                                                                                                 ''在起作用,否则是 intPre = 0 起作用
                               '字段名,全部转换成小写
                               strFieldName = LCase(Mid(cntControl.Name, intMidPos))
                               '确认是该表的字段 加空格表示是一个完整的字段
                               If InStr(strAllFieldName, ConSpace & strFieldName & ConSpace) > 0 Then ''如果该控件的名字在表的字段名中,则需要保存,否则不需要保存
                                   
                                   intType = rs.Fields(strFieldName).Type ''判断字段类型
                                   
                                   If TypeOf cntControl Is MaskEdBox Then
                                      '处理日期型的字段
                                       rs(strFieldName) = mskNull(cntControl, 0) '空值,msknull把未填入日期的msk转换成null,填入则不变
                                   Else
                                       '如果没有填入具体的值,则付null
                                       If Len(Trim(cntControl)) = 0 Then
                                          '数值型变量为空时把其转化成0
                                          If NumberToNullOrZero = False And _
                                               (intType = adDecimal Or intType = adInteger Or intType = adNumeric Or intType = adVarNumeric) Then
                                             rs(strFieldName) = 0
                                          Else
                                             rs(strFieldName) = Null ''否则转换成空值
                                          End If
                                       Else
                                           rs(strFieldName) = Trim(cntControl) ''如果text非空则直接填它的值
                                       End If
                                   End If
                            
                               End If
                               
                         End If
                         
                    End If
                    
            NextEnd If'处理一些界面上不能处理的字段,比如combox的下拉需要转换成编码
    If IsArray(varField) Then    For i = LBound(varField) To UBound(varField)
           
           strFieldName = LCase(Trim(varField(i))) ''遍历每一个字段名
           
            '确认是该表的字段 加空格表示是一个完整的字段,如果不是该表的字段,则不处理
           If InStr(strAllFieldName, ConSpace & strFieldName & ConSpace) > 0 Then
            
                If Len(varValue(i)) > 0 Then
                     rs(CStr(varField(i))) = Trim(varValue(i)) ''如果是有值的就填入值
                Else
                     rs(CStr(varField(i))) = Null ''没有值的被转换成空
                End If
           
           End If
           
        Next
        
    End Ifrs.Update ''提交记录'新建时保存成功返回1,修改时保存成功返回2,
    If blnNew Then
       recInSert = 1
    Else
       recInSert = 2
    End If'保存成功后把新建的标志改为修改记录的标志
    blnNew = FalseIf rs.state = adStateOpen Then rs.Close ''关闭记录集End Function
      

  2.   

    你们不要看代码,只看思想
    遍历所有窗体控件,如果是text或者msk,并且他在表字段名的命名里面,就把它的值写入ado
    最后提交
    我这只是个例子,大家有空来交流
    我里面有防止空的函数,暂时没有贴上来,sorry
      

  3.   

    基础版是我问的,我刚写了咯过程,大家共享一下
    '*************************************************************
    '函数功能:将窗体上的内容写入数据库
    '入口参数:指定窗体spForm,指定存储过程名字
    '限制条件:1、本函数必须与相应的存储过程匹配。存储过程名按“操作类型_表名”构成
    '          2、只适用于窗体上的文本框、下拉框和掩码框
    '          3、文本框用前缀Txt,下拉框用前缀Cob、掩码框用前缀Msk
    '*************************************************************
    Public Sub doDB(spForm As Form, spStoreP As String)
        Dim cnn As New ADODB.Connection
        Dim rs As New ADODB.Recordset
        Dim cmm As New ADODB.Command
        Dim cntcontrol As Control
        Dim Prefix As String, CName As String
        
        Call OpenDB(cnn)
        cmm.ActiveConnection = cnn
        cmm.CommandText = spStoreP
        cmm.CommandType = adCmdStoredProc
        
        For Each cntcontrol In spForm.Controls  ''遍历界面上所有的控件
             '只处理文本框和日期框
            If TypeOf cntcontrol Is MaskEdBox Or TypeOf cntcontrol Is ComboBox Or TypeOf cntcontrol Is TextBox Then
                CName = Trim(cntcontrol.Name): Prefix = Left(CName, 3)
                If Prefix = "Msk" Then cmm.Parameters("@" & Right(CName, Len(CName) - 3)) = Trim(cntcontrol.FormattedText)            If Prefix = "Cob" Or Prefix = "Txt" Then cmm.Parameters("@" & Right(CName, Len(CName) - 3)) = Trim(cntcontrol.Text)
            End If
        Next
        
        Set rs = cmm.Execute
        Set cmm = Nothing
        Set rs = Nothing
        Call CloseDB
    End Sub