functiondataaccess.bas

金水区行政审批服务软件窗口系统

'编写时间：2003-04-01 dww am 9:18
'更新时间：2003-07-26 dww pm14:58
'============================================================================================
Public Function DAUpdateData(In_sData() As String, in_TableName As String, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
   On Error GoTo DAUpdateDataErr
   DAUpdateData = False
   
   Dim iCols As Integer
   Dim lRows As Integer
   Dim iCurCol As Integer
   Dim lCurRow As Integer
   
   Dim In_SQry As String
   '判断要写入数据的表是否存在
   If in_TableName = "" Then
      Exit Function
   End If
   '通过语句打开要插入数据的的表
   In_SQry = "select * from " & in_TableName
   iCols = UBound(In_sData(), 2)
   lRows = UBound(In_sData(), 1)
   Set rs = New ADODB.Recordset
   Set db = New ADODB.Connection
   '===========================================================
   '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
    db.ConnectionString = frmShouJian.DBConectString
    db.Open
   '===========================================================
   Set rs = db.Execute(In_SQry)
   
   '通过SQL update 修改语句写数据，首先生成查询条件语句
   In_SQry = "update " & in_TableName
   In_SQry = In_SQry & "  set  "
   For lCurRow = 0 To lRows
    If Int(lRows / 2) = (lRows / 2) Then
       If lCurRow <= lRows - 1 Then
              In_SQry = In_SQry & In_sData(lCurRow, 0) & "='" & In_sData(lCurRow, 1) & "',"
       End If
       If lCurRow = lRows Then
              In_SQry = In_SQry & In_sData(lCurRow, 0) & "='" & In_sData(lCurRow, 1) & "'"
       End If
    Else
         If lCurRow < lRows Then
              In_SQry = In_SQry & In_sData(lCurRow, 0) & "='" & In_sData(lCurRow, 1) & "',"
         End If
   
         If lCurRow = lRows Then
            In_SQry = In_SQry & In_sData(lCurRow, 0) & "='" & In_sData(lCurRow, 1) & "'"
        End If
    End If
   Next lCurRow
   '执行修改操作
   Set rs = db.Execute(In_SQry)
   '关闭对象连接
   'rs.Close有点小问题如果关闭写入操作就会出错
   '释放对象
   Set rs = Nothing
   Set db = Nothing
   DAUpdateData = True
   Exit Function
DAUpdateDataErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   '提示错误信息
   If sErrDescr <> "" Then
     MsgBox "操作失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
End Function
'============================================================================================
'此函数用来保存申请表数据
'输入参数：In_sData(),In_TableName,in_TransactionCode分别接收申请表的主题数据数组，申请表名称
'          以及受理号，申请表主题数据也即申请表网格的内容
'输出参数：out_SaveSuccess接收保存数据是否成功
'详细描述：申请表中的数据有两部分：受理号+申请表主题数据也即网格中的数据，在调用此函数以前网格
'          中的数据必须已返回到一个2维数组
'编写时间：2003-06-12 dww  am10:31
'更新时间：2003-07-26  dww pm15:14
'============================================================================================
Public Function SaveAppTabData(In_sData() As String, in_TableName As String, in_TransactionCode, out_SaveSuccess As Boolean, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
   On Error GoTo SaveAppTabDataErr
   SaveAppTabData = False
   
   out_SaveSuccess = False
   Dim iCols As Integer
   Dim lRows As Integer
   Dim iCurCol As Integer
   Dim lCurRow As Integer
   
   Dim In_sQryFront As String
   Dim In_sQryLast As String
   Dim In_SQry As String
   '判断要写入数据的表是否存在
   If in_TableName = "" Then
      Exit Function
   End If
   '通过语句打开要插入数据的的表
   In_SQry = "select * from " & in_TableName
   iCols = UBound(In_sData(), 2)
   lRows = UBound(In_sData(), 1)
   Set rs = New ADODB.Recordset
   Set db = New ADODB.Connection
   '===========================================================
   '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
    db.ConnectionString = frmShouJian.DBConectString
    db.Open
   '===========================================================
   
   Set rs = db.Execute(In_SQry)
   '通过SQL insert插入语句写数据，首先生成查询条件语句
   '查询语句前半部分生成
   In_sQryFront = "insert into " & in_TableName
   In_sQryFront = In_sQryFront & "("
   For lCurRow = 0 To lRows - 1
     If Int(lRows / 2) = (lRows / 2) Then
       If lCurRow < lRows - 1 Then
                In_sQryFront = In_sQryFront & LTrim(In_sData(lCurRow, 0)) & ","
       End If
       If lCurRow = lRows - 1 Then
                In_sQryFront = In_sQryFront & In_sData(lCurRow, 0) & ")"
       End If
     Else
         If lCurRow < lRows - 1 Then
           In_sQryFront = In_sQryFront & In_sData(lCurRow, 0) & ","
         End If
         If lCurRow = lRows - 1 Then
           In_sQryFront = In_sQryFront & In_sData(lCurRow, 0) & ")"
         End If
     End If
   Next lCurRow
   '查询语句的后半部分语句生成
   In_sQryLast = In_sQryLast & "Values("
   For lCurRow = 0 To lRows - 1
    If Int(lRows / 2) = (lRows / 2) Then
       If lCurRow < lRows - 1 Then
          In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "',"
       End If
       If lCurRow = lRows - 1 Then
           In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "')"
       End If
    Else
       If lCurRow < lRows - 1 Then
          In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "',"
       End If
       If lCurRow = lRows - 1 Then
           In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "')"
       End If
   End If
   Next lCurRow
   '执行插入操作
    In_sQryFront = left(In_sQryFront, Len(In_sQryFront) - 1) & ",受理号)"
    In_sQryLast = left(In_sQryLast, Len(In_sQryLast) - 1) & ",'" & in_TransactionCode & "')"
    'Debug.Print In_sQryFront & In_sQryLast
    Set rs = db.Execute(In_sQryFront & In_sQryLast)
    out_SaveSuccess = True
    SaveAppTabData = True
   '关闭对象连接
   'rs.Close有点小问题如果关闭写入操作就会出错
   '释放对象
   Set rs = Nothing
   Set db = Nothing
SaveAppTabDataErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   If sErrDescr <> "" Then
   MsgBox "插入失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
   Exit Function
End Function
'============================================================================================
'此函数用来保存办件踏勘信息数据数据
'输入参数：In_sData(),In_TableName,in_TransactionCode,in_ItemName,in_AppDepartmentName,in_App
'          in_AppTel分别接收申请表的主题数据数组，踏勘表名称以及受理号，项目名称，申请单位名称,
'          申请的经办人和经办人联系方式，申请表主题数据也即踏勘信息表网格的内容
'输出参数：无输出参数
'详细描述：数据库踏勘表中的数据有两部分：受理号+项目名称+申报单位，踏勘表主题数据也即网格中的数
'          据，在调用此函数以前网格中的数据必须已返回到一个2维数组
'编写时间：2003-07-28 dww  am15:45
'更新时间：2003-10-16 dww  am12:03
'============================================================================================
Public Function SaveTaKanTabData(In_sData() As String, in_TableName As String, in_TransactionCode, in_ItemName As String, in_AppDepartmentName As String, isTransactionTaKan As String, in_AppJbr As String, in_AppTel As String, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
   On Error GoTo SaveTaKanTabDataErr
   SaveTaKanTabData = False
   
   Dim iCols As Integer
   Dim lRows As Integer
   Dim iCurCol As Integer
   Dim lCurRow As Integer
   
   Dim In_sQryFront As String
   Dim In_sQryLast As String
   Dim In_SQry As String
   '判断要写入数据的表是否存在
   If in_TableName = "" Then
      Exit Function
   End If
   '通过语句打开要插入数据的的表
   In_SQry = "select * from " & in_TableName
   iCols = UBound(In_sData(), 2)
   lRows = UBound(In_sData(), 1)
   Set rs = New ADODB.Recordset
   Set db = New ADODB.Connection
   '===========================================================
   '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
    db.ConnectionString = frmShouJian.DBConectString
    db.Open
   '===========================================================
   
   Set rs = db.Execute(In_SQry)
   '通过SQL insert插入语句写数据，首先生成查询条件语句
   '查询语句前半部分生成
   In_sQryFront = "insert into " & in_TableName
   In_sQryFront = In_sQryFront & "("
   For lCurRow = 0 To lRows - 1
     If Int(lRows / 2) = (lRows / 2) Then
       If lCurRow < lRows - 1 Then
                In_sQryFront = In_sQryFront & LTrim(In_sData(lCurRow, 0)) & ","
       End If
       If lCurRow = lRows - 1 Then
                In_sQryFront = In_sQryFront & In_sData(lCurRow, 0) & ")"
       End If
     Else
         If lCurRow < lRows - 1 Then
           In_sQryFront = In_sQryFront & In_sData(lCurRow, 0) & ","
         End If
         If lCurRow = lRows - 1 Then
           In_sQryFront = In_sQryFront & In_sData(lCurRow, 0) & ")"
         End If
     End If
   Next lCurRow
   '查询语句的后半部分语句生成
   In_sQryLast = In_sQryLast & "Values("
   For lCurRow = 0 To lRows - 1
    If Int(lRows / 2) = (lRows / 2) Then
       If lCurRow < lRows - 1 Then
          In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "',"
       End If
       If lCurRow = lRows - 1 Then
           In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "')"
       End If
    Else
       If lCurRow < lRows - 1 Then
          In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "',"
       End If
       If lCurRow = lRows - 1 Then
           In_sQryLast = In_sQryLast & "'" & In_sData(lCurRow, 1) & "')"
       End If
   End If
   Next lCurRow
   '执行插入操作
    In_sQryFront = left(In_sQryFront, Len(In_sQryFront) - 1) & ",受理号,项目名称,申报单位,已踏勘,经办人,经办人联系方式)"
    In_sQryLast = left(In_sQryLast, Len(In_sQryLast) - 1) & ",'" & in_TransactionCode & "','" & in_ItemName & "','" & in_AppDepartmentName & "','" & isTransactionTaKan & "','" & in_AppJbr & "','" & in_AppTel & "')"
    'Debug.Print In_sQryFront & In_sQryLast
    Set rs = db.Execute(In_sQryFront & In_sQryLast)
    SaveTaKanTabData = True
   '关闭对象连接
   'rs.Close有点小问题如果关闭写入操作就会出错
   '释放对象
   Set rs = Nothing
   Set db = Nothing
   '写入数据成功的提示信息
   'MsgBox "你已成功的将数据写入数据库" + Chr(13) + Chr(10) + "恭喜你！", 48, "系统提示"
   'Exit Function
SaveTaKanTabDataErr: