📄 frmtest.frm
字号:
rs2.Fields("Itemcode").Value = sCurItemCode
rs2.Fields("ItemName").Value = rs1.Fields("申报项目").Value
rs2.Fields("TransactionStartTime").Value = rs1.Fields("申报日期").Value
rs2.Fields("TransactionEndTime").Value = rs1.Fields("结束日期").Value
rs2.Fields("TransactionUpdateTime").Value = rs1.Fields("更新时间").Value
rs2.Fields("TransactionOperator").Value = rs1.Fields("受理人").Value
rs2.Fields("WhetherBL").Value = rs1.Fields("是否办理").Value
rs2.Fields("WhetherALreadyCharge").Value = rs1.Fields("已付费").Value
rs2.Fields("WhetherZF").Value = rs1.Fields("作废").Value
rs2.Fields("WhetherTB").Value = rs1.Fields("是否退办").Value
'--------------------------------------------------------------------------------
'处理是否补办字段的值，有点问题2003-11-2
rs2.Fields("WhetherBB").Value = rs1.Fields("补办完成").Value
'--------------------------------------------------------------------------------
If rs1.Fields("受件类型").Value = "上报件" Then
rs2.Fields("WhetherSB").Value = "是"
Else
rs2.Fields("WhetherSB").Value = "否"
End If
'-------------------------------------------------------------------------------
rs2.Fields("TransactionStatus").Value = rs1.Fields("受件状态").Value
rs2.Fields("TransactioAdvice").Value = "无"
rs2.Fields("TransactionAdviceMemory").Value = "利用原系统办件"
'-------------------------------------------------------------------------------
tempStr = ""
tempStr = Trim(rs1.Fields("付款方式").Value)
If tempStr = "直接付款" Then
rs2.Fields("TransactionChargeMean").Value = "现金"
Else
rs2.Fields("TransactionChargeMean").Value = rs1.Fields("付款方式").Value
End If
'--------------------------------------------------------------------------------
If Trim(rs1.Fields("交费类型").Value) = "正常" Then
rs2.Fields("TransactionChargeAction").Value = "交费"
Else
If Trim(rs1.Fields("交费类型").Value) = "续费" Then
rs2.Fields("TransactionChargeAction").Value = "补费"
Else
rs2.Fields("TransactionChargeAction").Value = "退费"
End If
End If
'--------------------------------------------------------------------
rs1.MoveNext
Loop
End If
End Sub
Private Sub Command2_Click()
'处理教文体局的数据转换的问题2003-11-1 dww pm18:40
Dim SQL1 As String
Dim SQL2 As String
Dim tempStr As String
Dim i As Integer
Set rs1 = New ADODB.Recordset
Set db1 = New ADODB.Connection
Set rs2 = New ADODB.Recordset
Set db2 = New ADODB.Connection
db1.ConnectionString = dbConStr1
db1.Open
db2.ConnectionString = dbConStr2
db2.Open
If sCurDepartmentCode = "41010509004" Then
SQL1 = "select * from banjian where 受理单位='" & sCurDepartmentOldName & "'and (申报项目='社会力量办学' or 申报项目='幼儿园注册')"
End If
If sCurDepartmentCode = "41010521004" Then
SQL1 = "select * from banjian where 受理单位='" & sCurDepartmentOldName & "' and (申报项目<>'社会力量办学' or 申报项目<>'幼儿园注册')"
End If
rs1.Open SQL1, db1, adOpenStatic, adLockReadOnly
If Not rs1.EOF Then
SQL2 = "select * from STra" + sCurDepartmentCode
rs2.Open SQL2, db2, adOpenDynamic, adLockOptimistic
Do While Not rs1.EOF
'----------------------------------------------------------------------
If sCurDepartmentCode = "41010509004" Then
Select Case Trim(rs1.Fields("申报项目"))
Case "社会力量办学"
sCurItemCode = "10020"
Case "幼儿园注册"
sCurItemCode = "10010"
End Select
End If
'----------------------------------------------------------------------
If sCurDepartmentCode = "41010521004" Then
tempStr = Trim(rs1.Fields("申报项目"))
For i = 0 To UBound(AllItemOfOneDepartment, 1)
If AllItemOfOneDepartment(i, 1) = tempStr Then
sCurItemCode = AllItemOfOneDepartment(i, 0)
Exit For
End If
Next i
End If
'--------------------------------------------------------------------
rs2.AddNew
rs2.Fields("TransactionCode").Value = rs1.Fields("受理号").Value
'------------------------------------------------------------------
'处理此处数据转换时候有点小问题2003-11-3 dww 11:16
rs2.Fields("tbl_TransactionProcedure").Value = "tbl_TransactionProcedure" + sCurDepartmentCode
rs2.Fields("tbl_TransactionCharge").Value = "tbl_TransactionCharge" + sCurDepartmentCode
rs2.Fields("tbl_CertificationPrintRecord").Value = "tbl_TransactionCertificationPrintRecord" + sCurDepartmentCode
rs2.Fields("tbl_SubmitApplicationMaterial").Value = "M" + sCurDepartmentCode + sCurItemCode
'-------------------------------------------------------------------
rs2.Fields("TransactionCodeIssueTime").Value = rs1.Fields("承诺时限").Value + "个工作日"
rs2.Fields("TransactionGroupNumber").Value = rs1.Fields("批办数量").Value
rs2.Fields("TransactionChargeTotal").Value = rs1.Fields("收费金额").Value
'--------------------------------------------------------------------
rs2.Fields("TransactionType").Value = rs1.Fields("受件类型").Value
'---------------------------------------------------------------------
rs2.Fields("DepartmentCode").Value = sCurDepartmentCode
rs2.Fields("DepartmentName").Value = rs1.Fields("受理单位").Value
rs2.Fields("Itemcode").Value = sCurItemCode
rs2.Fields("ItemName").Value = rs1.Fields("申报项目").Value
rs2.Fields("TransactionStartTime").Value = rs1.Fields("申报日期").Value
rs2.Fields("TransactionEndTime").Value = rs1.Fields("结束日期").Value
rs2.Fields("TransactionUpdateTime").Value = rs1.Fields("更新时间").Value
rs2.Fields("TransactionOperator").Value = rs1.Fields("受理人").Value
rs2.Fields("WhetherBL").Value = rs1.Fields("是否办理").Value
rs2.Fields("WhetherALreadyCharge").Value = rs1.Fields("已付费").Value
rs2.Fields("WhetherZF").Value = rs1.Fields("作废").Value
rs2.Fields("WhetherTB").Value = rs1.Fields("是否退办").Value
'--------------------------------------------------------------------------------
'处理是否补办字段的值，有点问题2003-11-2
rs2.Fields("WhetherBB").Value = rs1.Fields("补办完成").Value
'--------------------------------------------------------------------------------
If rs1.Fields("受件类型").Value = "上报件" Then
rs2.Fields("WhetherSB").Value = "是"
Else
rs2.Fields("WhetherSB").Value = "否"
End If
'-------------------------------------------------------------------------------
rs2.Fields("TransactionStatus").Value = rs1.Fields("受件状态").Value
rs2.Fields("TransactioAdvice").Value = "无"
rs2.Fields("TransactionAdviceMemory").Value = "利用原系统办件"
'-------------------------------------------------------------------------------
tempStr = ""
tempStr = Trim(rs1.Fields("付款方式").Value)
If tempStr = "直接付款" Then
rs2.Fields("TransactionChargeMean").Value = "现金"
Else
rs2.Fields("TransactionChargeMean").Value = rs1.Fields("付款方式").Value
End If
'--------------------------------------------------------------------------------
If Trim(rs1.Fields("交费类型").Value) = "正常" Then
rs2.Fields("TransactionChargeAction").Value = "交费"
Else
If Trim(rs1.Fields("交费类型").Value) = "续费" Then
rs2.Fields("TransactionChargeAction").Value = "补费"
Else
rs2.Fields("TransactionChargeAction").Value = "退费"
End If
End If
'--------------------------------------------------------------------
rs1.MoveNext
Loop
End If
End Sub
Private Sub GetAllItemOfOneDepartment(in_DepartmentCode As String, out_AllItemOfOneDepartment() As String)
'取得一个单位所有项目，包括：项目代码和项目名称转换时需要用2003-11-1 dww pm18:40
Dim i As Integer
Dim SQL As String
Set db3 = New ADODB.Connection
Set rs3 = New ADODB.Recordset
db3.ConnectionString = "driver={SQL server};Persist Security Info=False;User ID=;Database=ShenPi1;Server=LYSOFT-HQIS5DQ5"
db3.Open
SQL = "select * from TblItem" & " where DepartmentCode='" & in_DepartmentCode & "' order by itemcode"
rs3.Open "select * from TblItem" & " where departmentcode='" & in_DepartmentCode & "' order by itemcode", db3, adOpenStatic, adLockReadOnly
rs3.MoveFirst
If Not rs3.EOF Then
ReDim out_AllItemOfOneDepartment(rs3.RecordCount - 1, 1)
Do While Not rs3.EOF
out_AllItemOfOneDepartment(i, 0) = rs3.Fields("ItemCode").Value
out_AllItemOfOneDepartment(i, 1) = Trim(rs3.Fields("ItemName").Value)
'Debug.Print out_AllItemOfOneDepartment(i, 0)
'Debug.Print out_AllItemOfOneDepartment(i, 1)
'Debug.Print "-------------------------------"
rs3.MoveNext
i = i + 1
Loop
End If
rs3.Close
Set rs3 = Nothing
Set db3 = Nothing
End Sub
Private Sub JudgeDateIsHoliday(in_DateStr As String, out_IsHoliday As String)
'此过程的作用是判断是否为节假日
'输入参数：一个日期字符串
'输出参数：是或否的节假日标志变量
'编写时间：2004-2-12 dww pm
'-----------------------------------------------------------
Dim myYear As String
Dim myMonth As String
Dim myDay As String
Dim myWeek As String
'-----------------------------------------------------------
'计算过年的阳历值而需要的变量
Dim In_SolarDate As String
Dim out_LunarDate As String
Dim out_LunarNewYearSolarDate As String
Dim i As Integer
'-----------------------------------------------------------
myMonth = Month(CDate(in_DateStr))
'-----------------------------------------------------------
Select Case Val(myMonth)
Case 3, 4, 6, 7, 8, 9, 11, 12
'------------------------------------------------------------------------
Call GetWeekOfOneDay(CDate(in_DateStr), myWeek)
If myWeek = "星期六" Then
out_IsHoliday = "是"
Else
If myWeek = "星期日" Then
out_IsHoliday = "是"
Else
out_IsHoliday = "否"
End If
End If
'------------------------------------------------------------------------
Case 1
'------------------------------------------------------------------------
'一月里要考虑春节放假和元旦的情况
Call GetWeekOfOneDay(CDate(in_DateStr), myWeek)
If CDate(in_DateStr) = CDate(myYear + "-1-1") Then
out_IsHoliday = "是"
Exit Sub
End If
'------------------------------------------------------------------------
'春节考虑国家的法定放假时间7天，计算出过年的阳历值
For i = 0 To 30
In_SolarDate = CDate(in_DateStr) + i
Call SolarToLunar(In_SolarDate, out_LunarDate)
If out_LunarDate = "正月初一" Then
out_LunarNewYearSolarDate = In_SolarDate
Exit For
End If
Next i
'-----------------------------------------------------------------------
If myWeek = "星期六" Then
out_IsHoliday = "是"
Else
If myWeek = "星期日" Then
out_IsHoliday = "是"
Else
out_IsHoliday = "否"
End If
End If
If out_LunarNewYearSolarDate <> "" Then
If in_DateStr >= CDate(out_LunarNewYearSolarDate) And in_DateStr < CDate(out_LunarNewYearSolarDate) + 7 Then
out_IsHoliday = "是"
End If
End If
'------------------------------------------------------------------------
Case 2
'------------------------------------------------------------------------
'二月需要考虑春节放假的情况
Call GetWeekOfOneDay(CDate(in_DateStr), myWeek)
'在这里要判断加上承诺时限后是否为春节期间春节放假只考虑7天的情况
'-----------------------------------------------------------------------
'计算出过年的阳历值
For i = 0 To 30
In_SolarDate = CDate(in_DateStr) + i
Call SolarToLunar(In_SolarDate, out_LunarDate)
If out_LunarDate = "正月初一" Then
out_LunarNewYearSolarDate = In_SolarDate
Exit For
End If
Next i
'------------------------------------------------------------------------
If myWeek = "星期六" Then
out_IsHoliday = "是"
Else
If myWeek = "星期日" Then
out_IsHoliday = "是"
Else
out_IsHoliday = "否"
End If
End If
If out_LunarNewYearSolarDate <> "" Then
If CDate(in_DateStr) >= CDate(out_LunarNewYearSolarDate) And CDate(in_DateStr) < CDate(out_LunarNewYearSolarDate) + 7 Then
out_IsHoliday = "是"
End If
End If
'------------------------------------------------------------------------
Case 5
'------------------------------------------------------------------------
'五月里在五一放假期间只考虑放假七天的情况没有考虑其他的情况有局限的？
If CDate(in_DateStr) >= CDate(myYear + "-5-1") And CDate(in_DateStr) <= CDate(myYear + "-5-7") Then
out_IsHoliday = "是"
Else
out_IsHoliday = "否"
End If
'------------------------------------------------------------------------
Case 10
'------------------------------------------------------------------------
'十月里在十一放假期间只考虑放假七天的情况没有考虑其他的情况有局限的？
If CDate(in_DateStr) >= CDate(myYear + "-10-1") And CDate(in_DateStr) <= CDate(myYear + "-10-7") Then
out_IsHoliday = "是"
Else
out_IsHoliday = "否"
End If
'------------------------------------------------------------------------
End Select
End Sub
Private Sub CaculateStartTimeOrEndTimeOfCNJ(in_sCurAffirmatoryPeriod As String, in_DateStartTimeStr As String, out_DateStr As String)
'此过程的作用是求得承诺件的开始时间和结束时间（加上工作日）
'输入参数：承诺时限
'输出参数：计算后得到的时间
'编写时间：2004-2-12 dww pm19:31
Dim i As Integer
Dim isHoliday As String
out_DateStr = in_DateStartTimeStr
For i = 1 To Val(in_sCurAffirmatoryPeriod) - 1
out_DateStr = CDate(out_DateStr) + 1
isHoliday = "否"
Call JudgeDateIsHoliday(out_DateStr, isHoliday)
Do While isHoliday = "是"
out_DateStr = CDate(out_DateStr) + 1
isHoliday = "否"
Call JudgeDateIsHoliday(out_DateStr, isHoliday)
Loop
Next i
Debug.Print out_DateStr
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -