functiondataaccess.bas

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

   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语句及插入数据的语句inser into
   In_sQryFront = ""
   In_sQryFront = "insert into " & in_TableName & "(" & "TransactionCode,tbl_TransactionProcedure,tbl_SubmitApplicationMaterial,TransactioncodeIssueTime,TransactionGroupNumber,TransactionType,DepartmentCode,DepartmentName,ItemCode,ItemName,TransactionStartTime,TransactionUpdateTime,TransactionOperator,WhetherBL,WhetherAlreadyCharge,WhetherZF,WhetherTB,WhetherBB,WhetherSB,TransactionStatus,TransactionEndTime" & ")"
  '此处生成SQl语句插入数据的语句的后办部分
   Dim i As Integer
   '控制写数据的次数1行数据写一次，2行数据写2次
   'Debug.Print In_sQryFront
     In_sQryLast = "Values("
     For lcurcol = 0 To iCols - 1
          If lcurcol < iCols - 1 Then
              In_sQryLast = In_sQryLast & "'" & In_sData(i, lcurcol) & "',"
          End If
          If lcurcol = iCols - 1 Then
              In_sQryLast = In_sQryLast & "'" & In_sData(i, lcurcol) & "')"
          End If
     Next lcurcol
   '通过执行SQL语句实现插入操作
   'Debug.Print In_sQryFront & In_sQryLast
   Set rs = db.Execute(In_sQryFront & In_sQryLast)
   '释放对象
   Set rs = Nothing
   Set db = Nothing
   SaveTransacitonData1 = True
   Exit Function
SaveTransacitonData1Err:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   If sErrDescr <> "" Then
   MsgBox "插入失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
End Function
'============================================================================================
'第二个函数SaveTransacitonData2
'编写时间：2003-06-11 dww am11:22
'更新时间：2003-07-27 dww pm15:38
'============================================================================================
Public Function SaveTransacitonData2(In_sData() As String, in_TableName As String, in_TransactionCode As String, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
   On Error GoTo SaveTransacitonData2Err
   SaveTransacitonData2 = False
   Dim In_sQryFront As String
   Dim In_sQryLast As String
   '判断要写入数据的表是否存在
   If in_TableName = "" Then
      Exit Function
   End If
   '通过语句打开要插入数据的的表
   In_sQryLast = " where TransactionCode='" & in_TransactionCode & "'"
   Set rs = New ADODB.Recordset
   Set db = New ADODB.Connection
   '===========================================================
   '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
    db.ConnectionString = frmShouJian.DBConectString
    db.Open
   '===========================================================
  '此出生成SQL语句及插入数据的语句update
   In_sQryFront = ""
   In_sQryFront = "update " & in_TableName & " set "
  
   In_sQryFront = In_sQryFront & "tbl_TransactionCharge= '" & In_sData(0, 0) & "', TransactionChargeTotal=" & CCur(In_sData(0, 1)) & ", TransactionChargeAction='" & In_sData(0, 2) & "',TransactionChargeMean='" & In_sData(0, 3) & "'" & ",WhetherALreadyCharge='" & In_sData(0, 4) & "'" & ",TransactionUpdateTime='" & In_sData(0, 5) & "'" & ",TransactionStatus='" & In_sData(0, 6) & "'"
   '通过执行SQL语句实现插入操作
   Set rs = db.Execute(In_sQryFront & In_sQryLast)
  '释放对象
   Set rs = Nothing
   Set db = Nothing
   SaveTransacitonData2 = True
   Exit Function
SaveTransacitonData2Err:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   If sErrDescr <> "" Then
     MsgBox "更新失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
End Function
'============================================================================================
'第三个函数SaveTransacitonData3
'编写时间：2003-06-11 dww am11:22
'更新时间：2003-07-27 dww pm15:37
'============================================================================================
Public Function SaveTransacitonData3(In_sData() As String, in_TableName As String, in_TransactionCode As String, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
   On Error GoTo SaveTransacitonData3Err
   SaveTransacitonData3 = False
   Dim In_sQryFront As String
   Dim In_sQryLast As String
   '判断要写入数据的表是否存在
   If in_TableName = "" Then
      Exit Function
   End If
   '通过语句打开要插入数据的的表
   In_sQryLast = " where TransactionCode='" & in_TransactionCode & "'"
   Set rs = New ADODB.Recordset
   Set db = New ADODB.Connection
   '===========================================================
   '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
    db.ConnectionString = frmShouJian.DBConectString
    db.Open
   '===========================================================
   '此出生成SQL语句及插入数据的语句update
   In_sQryFront = ""
   In_sQryFront = "update " & in_TableName & " set "
   
   In_sQryFront = In_sQryFront & "TransactioAdvice= '" & In_sData(0, 0) & "', TransactionAdviceMemory='" & In_sData(0, 1) & "'"
   '通过执行SQL语句实现插入操作
   Set rs = db.Execute(In_sQryFront & In_sQryLast)
  '释放对象
   Set rs = Nothing
   Set db = Nothing
   SaveTransacitonData3 = True
   Exit Function
SaveTransacitonData3Err:
   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分别接收要写的数据，要写数据库表名称和受理号
'输出参数：无输出参数
'详细描述：针对物价局的特点将他的证书录入也急申请表数据的录入专门做了一个界面来实现信息的方便的录入
'现在要实现的是如何将信息存入数据库即写入物价局的项目申请表中去，现在用一张表来记录打证信息数据和申
'请表，这样记录数据是否很好还没有得到实践认证如果能把信息记录分得更细那将更好，如专门有记录申请表的
'数据库表，也有专门记录打证信息的数据库表
'注意：此处写入收费子项最多有9个子项因为数据库中最多只有9个子项的字段要想增加收费子项一定要修改数据
'中表结构
'编写时间：2003-06-20 dww pm 18:24
'更新时间：2003-07-27 dww pm15:21
'============================================================================================
Public Function SaveWuJiaShouFeiXiangMu(In_sData() As String, in_TableName As String, in_TransactionCode As String, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
  On Error GoTo SaveWuJiaShouFeiXiangMuErr
   SaveWuJiaShouFeiXiangMu = False
   Dim i As Integer
   Dim j As Integer
   Dim In_sQryFront As String
   Dim In_sQryLast As String
   '判断要写入数据的表是否存在
   If in_TableName = "" Then
      Exit Function
   End If
   '通过语句打开要插入数据的的表
   In_sQryLast = " where 受理号='" & in_TransactionCode & "'"
   Set rs = New ADODB.Recordset
   Set db = New ADODB.Connection
   '===========================================================
   '将所有的数据源连接该为连接字符串连接2003-08-01 dww pm18:53
    db.ConnectionString = frmShouJian.DBConectString
    db.Open
   '===========================================================
  '此处生成SQL语句既修改数据的语句update
   In_sQryFront = ""
   In_sQryFront = "update " & in_TableName & " set "
   
   For i = 0 To UBound(In_sData, 1) - 1
   Debug.Print UBound(In_sData, 2)
   If i < UBound(In_sData, 1) - 1 Then
    In_sQryFront = In_sQryFront & "序号" + Trim(Str(i + 1)) & "='" & In_sData(i, 0) & "',收费项目" + Trim(Str(i + 1)) & "='" & In_sData(i, 1) & "'," & "计算单位" + Trim(Str(i + 1)) & "='" & In_sData(i, 2) & "'," & "收费标准" + Trim(Str(i + 1)) & "='" & In_sData(i, 3) & "'," & "批准收费的机关及文号" + Trim(Str(i + 1)) & "='" & In_sData(i, 4) & "'," & "经办人审核人及办理时间" + Trim(Str(i + 1)) & "='" & In_sData(i, 5) & "'," & "备注" + Trim(Str(i + 1)) & "='" & In_sData(i, 6) & "',"
   Else
    In_sQryFront = In_sQryFront & "序号" + Trim(Str(i + 1)) & "='" & In_sData(i, 0) & "',收费项目" + Trim(Str(i + 1)) & "='" & In_sData(i, 1) & "'," & "计算单位" + Trim(Str(i + 1)) & "='" & In_sData(i, 2) & "'," & "收费标准" + Trim(Str(i + 1)) & "='" & In_sData(i, 3) & "'," & "批准收费的机关及文号" + Trim(Str(i + 1)) & "='" & In_sData(i, 4) & "'," & "经办人审核人及办理时间" + Trim(Str(i + 1)) & "='" & In_sData(i, 5) & "'," & "备注" + Trim(Str(i + 1)) & "='" & In_sData(i, 6) & "'"
   End If
   Next i
   
   '测试输出
   'Debug.Print In_sQryFront
   
   '通过执行SQL语句实现插入操作
   Set rs = db.Execute(In_sQryFront & In_sQryLast)
   
   '释放对象
   Set rs = Nothing
   Set db = Nothing
   SaveWuJiaShouFeiXiangMu = True
   'MsgBox "你已成功的将数据写入数据库" + Chr(13) + Chr(10) + "恭喜你！", 48, "系统提示"
   'Exit Function
SaveWuJiaShouFeiXiangMuErr:
   lErrNu = Err.Number
   sErrDescr = Err.Description
   If sErrDescr <> "" Then
   MsgBox "插入失败" + Chr(13) + Chr(10) + sErrDescr, 48, "错误警告"
   End If
   Exit Function
End Function
'============================================================================================
'此函数功能是直接取出项目查询所需的数据
'输入参数：in_sDepartmentcode接收单位代码
'输出参数：out_sItemQueryNeedData,out_isEmpty接收符合条件的项目数据和该项目数组是否为空的标志
'详细描述：项目查询界面所需的数据包括：项目名称，办件类型，承诺时限，办事程序，申报材料，收费金额
'          是否收费，收费标准，政策依据等此函数的功能是从项目表中直接取出数据到数组中
'编写时间：2003-06-25 dww am10:39
'更新时间：2003-07-27 dww pm15:06
'============================================================================================
Public Function GetItemQueryNeedData(in_sDepartmentcode As String, out_sItemQueryNeedData() As String, out_isEmpty As Boolean, Optional lErrNu As Long, Optional sErrDescr As String) As Boolean
   On Error GoTo GetItemQueryNeedDataErr
      GetItemQueryNeedData = False
      out_isEmpty = True
      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 * from " & gsItemStorageName & " where DepartmentCode= '" & in_sDepartmentcode & "'", db, adOpenStatic, adLockReadOnly
      Static i As Integer
      i = 0
      Do While Not rs.EOF
            ReDim Preserve out_sItemQueryNeedData(9, i)
            '---------------------------------------------------------------
            If rs.Fields("ItemName").Value <> "" Then
                  out_sItemQueryNeedData(0, i) = rs.Fields("ItemName").Value
            End If
            '---------------------------------------------------------------
            If rs.Fields("TransactionTypeCode").Value <> "" Then
                  out_sItemQueryNeedData(1, i) = rs.Fields("TransactionTypeCode").Value
            End If
            '---------------------------------------------------------------
            If rs.Fields("AffirmatoryPeriod").Value <> "" Then
                  out_sItemQueryNeedData(2, i) = rs.Fields("AffirmatoryPeriod").Value
            End If
            '---------------------------------------------------------------
            If rs.Fields("TransactionProcedureDescription").Value <> "" Then
                   out_sItemQueryNeedData(3, i) = rs.Fields("TransactionProcedureDescription").Value
            End If
            '---------------------------------------------------------------
            If rs.Fields("ApplicationMaterialDescription").Value <> "" Then
                   out_sItemQueryNeedData(4, i) = rs.Fields("ApplicationMaterialDescription").Value
            End If
            '---------------------------------------------------------------
            If rs.Fields("ChargeAmount").Value <> "" Then
                   out_sItemQueryNeedData(5, i) = rs.Fields("ChargeAmount").Value
            End If
            '---------------------------------------------------------------
            If rs.Fields("IsCharge").Value <> "" Then
                   out_sItemQueryNeedData(6, i) = rs.Fields("IsCharge").Value
            End If
            '---------------------------------------------------------------
            If rs.Fields("ChargeStand").Value <> "" Then
                   out_sItemQueryNeedData(7, i) = rs.Fields("ChargeStand").Value
            End If
            '---------------------------------------------------------------
            If rs.Fields("DependingPolicy").Value <> "" Then
                   out_sItemQueryNeedData(8, i) = rs.Fields("DependingPolicy").Value
            End If
            '---------------------------------------------------------------
            '将项目表中的办件类型代码进行转换1，2，3转换成上报件，即办件，承诺件
            Select Case out_sItemQueryNeedData(1, i)
               Case "1"
                 out_sItemQueryNeedData(1, i) = "上报件 "
               Case "2"