functiondataaccess.bas

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

             '---------------------------------------------------------------
             If rs.Fields("ItemCode").Value <> "" Then
                out_sItemDirectionNeedData(0, 0) = rs.Fields("ItemCode").Value
             End If
             '---------------------------------------------------------------
             If rs.Fields("ItemName").Value <> "" Then
                out_sItemDirectionNeedData(0, 1) = rs.Fields("ItemName").Value
             End If
             '---------------------------------------------------------------
             If rs.Fields("TransactionTypeCode").Value <> "" Then
                out_sItemDirectionNeedData(0, 2) = rs.Fields("TransactionTypeCode").Value
             End If
             '---------------------------------------------------------------
             If rs.Fields("ItemKindCode").Value <> "" Then
                out_sItemDirectionNeedData(0, 3) = rs.Fields("ItemKindCode").Value
             End If
             '---------------------------------------------------------------
             If rs.Fields("TransactionProcedureDescription").Value <> "" Then
                out_sItemDirectionNeedData(0, 4) = rs.Fields("TransactionProcedureDescription").Value
             End If
             '---------------------------------------------------------------
             If rs.Fields("ApplicationMaterialDescription").Value <> "" Then
                out_sItemDirectionNeedData(0, 5) = rs.Fields("ApplicationMaterialDescription").Value
             End If
             '---------------------------------------------------------------
             If rs.Fields("ChargeStand").Value <> "" Then
                out_sItemDirectionNeedData(0, 6) = rs.Fields("ChargeStand").Value
             End If
             '---------------------------------------------------------------
             If rs.Fields("DependingPolicy").Value <> "" Then
                out_sItemDirectionNeedData(0, 7) = rs.Fields("DependingPolicy").Value
             End If
             '---------------------------------------------------------------
       End If
       '因在项目表中的项目数据为数字形式1，2，3 为此需要转换一下
       '现在只能转换3种项目类型：上报件，即办件，承诺件此处要考虑如何扩展的问题？
       Select Case out_sItemDirectionNeedData(0, 2)
               Case "1"
                 out_sItemDirectionNeedData(0, 2) = "上报件 "
               Case "2"
                 out_sItemDirectionNeedData(0, 2) = "即办件"
               Case "3"
                 out_sItemDirectionNeedData(0, 2) = "承诺件"
       End Select
       '因在项目表中项目性质数据也为数字代码形式10，11，12为此需要转换一下
       '现在只能转换7类项目，此处要考虑扩展问题？
       Select Case out_sItemDirectionNeedData(0, 3)
               Case "10"
                out_sItemDirectionNeedData(0, 3) = "审批项目"
               Case "11"
                out_sItemDirectionNeedData(0, 3) = "审批/审批"
               Case "12"
                out_sItemDirectionNeedData(0, 3) = "审批/审核"
               Case "13"
                out_sItemDirectionNeedData(0, 3) = "审批/核准"
               Case "14"
                out_sItemDirectionNeedData(0, 3) = "审批/备案"
               Case "20"
                out_sItemDirectionNeedData(0, 3) = "收费项目"
               Case "30"
                out_sItemDirectionNeedData(0, 3) = "罚没项目"
       End Select
       rs.Close
       Set db = Nothing
       Set rs = Nothing
    GetItemDirectionNeedData = True
GetItemDirectionNeedDataErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   '提示错误信息
   If sErrDescr <> "" Then
     MsgBox "操作失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
End Function
'============================================================================================
'此函数的功能是取出某个单位所有的工作人员姓名
'输入参数：in_departmentName接收单位名称（此处最好用单位代码作查询条件，防止重名）
'          暂时我用单位名称作查询条件也就是找一个单位的所有工作人员
'输出参数：in_ComboObject接收一个组合框对象，因为要用取得的工作人员姓名来填充组合框
'详细描述：通过此函数可以取得一个单位所有的工作人员姓名然后填充这个组合框，在办件查询
'          办件统计等地方有关人员的组合框都要调用此函数
'编写时间：2003-06-06 dww pm17:00
'更新时间：2003-07-26 dww pm14:23
'============================================================================================
Public Function GetAllWorkerName(in_departmentName As String, in_ComboObject As ComboBox, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
   On Error GoTo GetAllWorkerNameErr
    GetAllWorkerName = False
    
    Set db = New ADODB.Connection
    Set rs = New ADODB.Recordset
    '===========================================================
    '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
    db.ConnectionString = frmShouJian.DBConectString
    db.Open
    '===========================================================
    rs.Open "select workername from " & gsWorkerTblStorageName & " where departmentname='" & in_departmentName & " '", db, adOpenStatic, adLockReadOnly
    Dim i As String
    Dim t As Integer
    in_ComboObject.AddItem "全部人员"
    For t = 0 To Val(rs.RecordCount) - 1
         i = Trim(rs.Fields("workername").Value)
         rs.MoveNext
         in_ComboObject.AddItem i
    Next t
    
    rs.Close
    '释放对象
    Set rs = Nothing
    Set db = Nothing
    GetAllWorkerName = True
GetAllWorkerNameErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   '提示错误信息
   If sErrDescr <> "" Then
     MsgBox "操作失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
End Function
'============================================================================================
'此函数的功能是取出一个单位的所有项目
'输入参数：in_DepartmentCode接收单位代码
'输出参数：in_ComboObject接收一个组合框，取得需要的数据来填充组合框
'详细描述：此函数现在只能取出本单位的的所有项目但代理单位的项目和并联单位单位的项目取不出来
'          为了能取出代理单位和并联单位的项目必须进行完善，统计和查询数据时项目组合框的数据
'          的取得都要调用该函数
'编写时间：2003-06-06 dww pm 17:03
'更新时间：2003-07-26 dww pm 14:41
'============================================================================================
Public Function GetOneDepartmentItemName(in_DepartmentCode As String, in_ComboObject As ComboBox, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
    On Error GoTo GetOneDepartmentItemNameErr
      GetOneDepartmentItemName = False

      Set db = New ADODB.Connection
      Set rs = New ADODB.Recordset
      '===========================================================
      '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
        db.ConnectionString = frmShouJian.DBConectString
        db.Open
      '===========================================================
      
      rs.Open "select itemname from " & gsItemStorageName & " where departmentcode='" & in_DepartmentCode & " '", db, adOpenStatic, adLockReadOnly
      Dim i As String
      Dim t As Integer
      in_ComboObject.AddItem "全部项目"
      For t = 0 To Val(rs.RecordCount) - 1
            i = Trim(rs.Fields("itemname").Value)
            rs.MoveNext
            in_ComboObject.AddItem i
       Next t
       
      rs.Close
      '释放对象
      Set rs = Nothing
      Set db = Nothing
     GetOneDepartmentItemName = True
GetOneDepartmentItemNameErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   '提示错误信息
   If sErrDescr <> "" Then
     MsgBox "操作失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
End Function
'============================================================================================
'此函数功能是向数据库中写数据
'输入参数：In_sData()接收要写入的数据2维数组
'          In_TableName接收要写入数据的数据库中的表名称
'详细描述：以下代码将实现写数据到数据库中这段我最早是在2003-3-25 am 9:00编写的，后来在
'          2003-06-06 pm 16:05引用此段代码实现保存数据的操作这是实现保存数据比较通用的操作
'编写时间：2003-03-25 dww am 9:00
'更新时间：2003-07-26 dww pm 14:51
'============================================================================================
Public Function DAWriteData(In_sData() As String, in_TableName As String, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
   On Error GoTo DAWriteDataErr
   DAWriteData = 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 insert插入语句写数据，首先生成查询条件语句
   '查询语句前半部分生成
   In_SQry = ""
   In_SQry = "insert into " & in_TableName
   In_SQry = In_SQry & "("
   For lCurRow = 0 To lRows
      If Int(lRows / 2) = (lRows / 2) Then
           If lCurRow <= lRows - 1 Then
                  In_SQry = In_SQry & LTrim(In_sData(lCurRow, 0)) & ","
           End If
           If lCurRow = lRows Then
                  In_SQry = In_SQry & In_sData(lCurRow, 0) & ")"
           End If
      Else
           If lCurRow < lRows - 1 Then
                  In_SQry = In_SQry & In_sData(lCurRow, 0) & ","
           End If
           If lCurRow = lRows - 1 Then
                  In_SQry = In_SQry & In_sData(lCurRow, 0) & ")"
           End If
     End If
   Next lCurRow
   '查询语句的后半部分语句生成
   In_SQry = In_SQry & "Values("
   For lCurRow = 0 To lRows
      If Int(lRows / 2) = (lRows / 2) Then
          If lCurRow <= lRows - 1 Then
                  In_SQry = In_SQry & "'" & In_sData(lCurRow, 1) & "',"
          End If
          If lCurRow = lRows Then
                  In_SQry = In_SQry & "'" & In_sData(lCurRow, 1) & "')"
          End If
      Else
          If lCurRow < lRows - 1 Then
                  In_SQry = In_SQry & "'" & In_sData(lCurRow, 1) & "',"
          End If
          If lCurRow = lRows - 1 Then
                  In_SQry = In_SQry & "'" & In_sData(lCurRow, 1) & "')"
          End If
      End If
   Next lCurRow
   '执行插入操作
    Set rs = db.Execute(In_SQry)
    DAWriteData = True
   '关闭对象连接
   'rs.Close有点小问题如果关闭写入操作就会出错
   '释放对象
   Set rs = Nothing
   Set db = Nothing
   Exit Function
DAWriteDataErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   If sErrDescr <> "" Then
   MsgBox "插入失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
   Exit Function
End Function
'============================================================================================
'此函数功能是修改数据库中的数据用的是以前的函数
'输入参数：In_sData()接收要修改的数据2维数组
'输出参数：In_TableName接收要修改数据的表名
'详细描述：以下代码将实现修改数据到数据库中我最早写这段代码是在2003-04-01 am 9:18后来在
'          2003-06-06 am 16:07引用此段代码实现修改数据的操作