Ｋ３中更新数据库的常规操作

Private Sub m_billtransfer_BeforeSave(ByVal bNew As Boolean, ReturnCode As Long)

    Dim objAPP As Object
    Dim adoRS As ADODB.Recordset
    Dim strSQL As String

   
    Dim strContract As String
    Dim strSummary As String
    Dim strOrderNo As String
    Dim strFieldName As String
    Dim strSummaryFieldName As String

    Dim iContract As Integer
    Dim iSummary As Integer
    Dim iOrderNo As Integer
   
   
   
    On Error GoTo Err
   
    Set objAPP = CreateObject("K3MAppconnection.AppConnection")
   
    '找到合同号码和摘要的字段名
    strSQL = "SELECT FFieldName From ICTemplate WHERE FID='S01' AND FCaption='合同号码：' "
    Set adoRS = objAPP.getanyrecordset(m_billtransfer.Cnnstring, strSQL)
    While Not adoRS.EOF
        strFieldName = adoRS(0)
        adoRS.MoveNext
    Wend
    strSQL = "SELECT FFieldName From ICTemplate WHERE FID='S01' AND FCaption='摘    要：' "
    Set adoRS = objAPP.getanyrecordset(m_billtransfer.Cnnstring, strSQL)
    While Not adoRS.EOF
        strSummaryFieldName = adoRS(0)
        adoRS.MoveNext
    Wend
    '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    For i = LBound(m_billtransfer.HeadCtl) To UBound(m_billtransfer.HeadCtl)
         If m_billtransfer.HeadCtl(i).Caption = "合同号码：" Then
        
             iContract = i
            
         End If
         If m_billtransfer.HeadCtl(i).Caption = "摘    要：" Then
        
             iSummary = i
            
         End If
         If m_billtransfer.HeadCtl(i).Caption = "订单编号：" Then
        
             iOrderNo = i
            
         End If
    Next i
   
    With m_billtransfer
        strContract = .GetHeadText(iContract)
        strSummary = .GetHeadText(iSummary)
        strOrderNo = .GetHeadText(iOrderNo)
    End With
   
    strSQL = "Update SEOrder SET " & strFieldName & "='" & strContract & "'," & strSummaryFieldName & "='" & strSummary & "' WHERE FBillNo='" & strOrderNo & "'"
   
    'upDateOrder = "update SEOrder set FExplanation='" & bodyzyvalue & "',FHeadSelfS0142='" & bodyhtValue & " ' from SEOrder where FBillNo='" & xsddhValue & "'"
   
    Set adoRS = objAPP.getanyrecordset(m_billtransfer.Cnnstring, strSQL)
   
   
    Set adoRS = Nothing
    Set objAPP = Nothing

Err:
    'MsgBox "更新数据库失败，请联系IT人员"

End Sub