Public Partial Class Doc_List_Excel
Inherits System.Web.UI.Page
#Region "变量宣告区"
'Dim Ap_Code As String
'Dim Func_Code As String
'Dim CSet As String
Dim Ap_Color As String
'Dim Manager As Short
'Dim folder_id As String
'Dim file_type As String
'read submit form infos
'Dim ProcType As String = ""
Dim Q_Type As String = "" '状态说明
Dim TypeVal As String = ""
Dim cols As Integer '取合并列值
Dim Tcols As Integer '小计、合计取合并列值
'Dim Q_Employ_NO As String = ""
'Dim Q_Employ_Name As String = ""
Dim Q_App_DateS As Date
Dim Q_App_DateE As Object
Dim Q_App_DateSS As String = ""
Dim Q_App_DateES As String = ""
Dim Q_App_DateSSS As String = ""
Dim Q_App_DateESS As String = ""
'Dim Q_Category As String = ""
'Dim Q_Status As String = ""
'控制使用
Dim Modify_Employ As String
Dim BIDatai As Integer
Dim SendSignCount As Integer = 0
Dim SendSignList As String = ""
Dim NoSDate As String = ""
Dim NoEDate As String = ""
Dim StaDate As String = "" '查询开始时间
Dim EndDate As String = "" '查询结束时间
'分组取个人小计
Dim Slm_Conn As Status.PowerKernel.Connection = New Status.PowerKernel.Connection
Dim Slm_str As String = ""
Dim SlmRs As ADODB.Recordset = New ADODB.Recordset
Dim SlmCount As Integer = 0
Dim msg As PowerSystem.SystemMsg
Dim check As PowerSystem.CheckRSValue
#End Region
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Response.ContentEncoding = System.Text.Encoding.UTF8
msg = New PowerSystem.SystemMsg
check = New PowerSystem.CheckRSValue
StaDate = Request.Form.Item("App_DateS")
EndDate = Request.Form.Item("App_DateE")
'Ap_Code = "FeeApply"
'Func_Code = "FeeApply"
'file_type = "FeeApplyExc"
Ap_Color = "#FDCDAD"
'Ap_color = "#CFE4D4"
If Not LoadQuery() Then
Response.Write("<script>alert('没有资料或资料读取错误,请重新选择时间段!');</script>")
Response.End()
Exit Sub
End If
PageLoad()
End Sub
Sub PageLoad()
Response.Write("<html>" & vbCrLf)
Response.Write("<head>" & vbCrLf)
Response.Write("<Meta Http-Equiv=""Content-Type"" Content=""text/html; charset=" & Application("SYSTEM_CharSet") & """>" & vbCrLf)
Response.Write("</head>" & vbCrLf)
'===========查询结果界面 start===============
Response.Write("<br>" & vbCrLf)
Response.Write("<table border=1 width=60% align=center cellspacing=0 class=smooth9>" & vbCrLf)
'取合并列值
TypeVal = Trim(Request.Form.Item("TypeValue"))
cols = 3
Tcols = 7
Response.Write(" <tr>" & vbCrLf)
If TypeVal = "Housing" Then
Response.Write(" <td colspan=9 align=center><strong><span style=""font-size: 14pt"">" & Q_Type & "明细报表</span></strong></td>" & vbCrLf)
ElseIf TypeVal = "PlaneTicket" Then
Response.Write(" <td colspan=12 align=center><strong><span style=""font-size: 14pt"">" & Q_Type & "明细报表</span></strong></td>" & vbCrLf)
Else
Response.Write(" <td colspan=4 align=center><strong><span style=""font-size: 14pt"">" & Q_Type & "明细报表</span></strong></td>" & vbCrLf)
End If
Response.Write(" </tr>" & vbCrLf)
Response.Write(" <tr align=center>" & vbCrLf)
Response.Write(" <td>期间</td>" & vbCrLf)
If Q_App_DateSS <> "" And Q_App_DateES <> "" Then
Response.Write(" <td align=center colspan=" & cols & "><strong>" & Q_App_DateSS & " ~ " & Q_App_DateES & "</strong></td>" & vbCrLf)
Else
Response.Write(" <td align=center colspan=" & cols & "></td>" & vbCrLf)
End If
Response.Write(" </tr>" & vbCrLf)
Response.Write(" <tr align=center>" & vbCrLf)
Response.Write(" <td nowrap>日期</td>" & vbCrLf)
Response.Write(" <td nowrap>合同编号</td>" & vbCrLf)
Response.Write(" <td nowrap>合同内容</td>" & vbCrLf)
Response.Write(" <td nowrap>经办人</td>" & vbCrLf)
Response.Write(" </tr>" & vbCrLf)
LoadData()
Response.Write("</table>" & vbCrLf)
'==================================查询结果界面 end=====================================
Response.ContentType = "application/vnd.ms-excel"
Dim filecnname As String = "合同" & Q_App_DateS & Q_App_DateE & ".xls"
Response.AddHeader("Content-Disposition", "attachment; filename=" & System.Web.HttpUtility.UrlEncode(filecnname))
Response.ContentEncoding = System.Text.Encoding.GetEncoding("UTF-8") '设置编码为文件名支持中文
Response.Write("</body>" & vbCrLf)
Response.Write("</html>" & vbCrLf)
End Sub
Function LoadQuery() As Boolean
TypeVal = Trim(Request.Form.Item("TypeValue")) '获取Housing、PlaneTicket
If TypeVal = "Housing" Then
Q_Type = "住房补助申请"
End If
If TypeVal = "PlaneTicket" Then
Q_Type = "返乡机票申请"
End If
If TypeVal = "OtherAid" Then
Q_Type = "其他补助申请"
End If
Q_Type = "合同时间段"
Response.Write(Q_Type & "<br>")
Try
If Trim(Request.Form.Item("App_DateS")) <> "" Then
Q_App_DateS = CDate(Trim(Request.Form.Item("App_DateS")))
Q_App_DateSS = CDate(Trim(Request.Form.Item("App_DateS"))).Year.ToString & "/" & CDate(Trim(Request.Form.Item("App_DateS"))).Month.ToString & "/" & CDate(Trim(Request.Form.Item("App_DateS"))).Day.ToString
Q_App_DateSSS = FormatNum(Q_App_DateS.Year, 4) & FormatNum(Q_App_DateS.Month, 2) & FormatNum(Q_App_DateS.Day, 2) & " 00:00:01"
Else
NoSDate = "Y"
End If
Catch ex As Exception
NoSDate = "Y"
End Try
Try
If Trim(Request.Form.Item("App_DateE")) <> "" Then
Q_App_DateE = CDate(Trim(Request.Form.Item("App_DateE")))
Q_App_DateES = CDate(Trim(Request.Form.Item("App_DateE"))).Year.ToString & "/" & CDate(Trim(Request.Form.Item("App_DateE"))).Month.ToString & "/" & CDate(Trim(Request.Form.Item("App_DateE"))).Day.ToString
Q_App_DateESS = FormatNum(Q_App_DateE.Year, 4) & FormatNum(Q_App_DateE.Month, 2) & FormatNum(Q_App_DateE.Day, 2) & " 23:59:59"
Else
NoEDate = "Y"
End If
Catch ex As Exception
NoEDate = "Y"
End Try
Slm_str = " Select top 1 doc_id from sign_log_main where doc_id like 'contractNo%' and app_date between '" & StaDate & "' and '" & EndDate & "' Order By app_date Desc "
SlmRs = Slm_Conn.OpenRs(Slm_str, "2")
SlmCount = 0
SlmCount = SlmRs.RecordCount
If SlmCount < 0 Or SlmCount = 0 Then
Return False
Else
Return True
End If
End Function
Sub LoadData()
'读取分组后人员信息
If SlmCount > 0 Then
Do While (Not SlmRs.EOF)
Slm_Conn = New Status.PowerKernel.Connection
SlmRs = Nothing
SlmCount = 0
Slm_str = ""
'日期,合同编号,合同内容,经办人
'2.1.0 Namielu 加上Department Table relation
Slm_str = " Select top 100 doc_id,app_date,log_id,app_memo,app_name from sign_log_main where doc_id like 'contractNo%' and app_date between '" & StaDate & "' and '" & EndDate & "' Order By app_date Desc "
SlmRs = Slm_Conn.OpenRs(Slm_str, "2")
SlmCount = 0
SlmCount = SlmRs.RecordCount
If SlmCount > 0 Then
'SlmRs.MoveFirst()
BIDatai = 0
'列资料
Dim app_date As String = "" '日期
Dim log_id As String = "" '合同编号
Dim app_memo As String = "" '合同内容
Dim app_name As String = "" '经办人
Do While (Not SlmRs.EOF)
app_date = ""
log_id = ""
app_memo = ""
app_name = ""
app_date = CDate(SlmRs.Fields.Item("app_date").Value)
log_id = Trim(SlmRs.Fields.Item("log_id").Value)
app_memo = Trim(SlmRs.Fields.Item("app_memo").Value)
app_name = Trim(Trim(SlmRs.Fields.Item("app_name").Value))
'Q_Status = Trim(SlmRs.Fields.Item("is_close").Value)
'If Q_Status = "1" Then
' Q_Status = "签核完成"
'End If
'If Q_Status = "0" Then
' Q_Status = "签核中"
'End If
BIDatai = BIDatai + 1
Response.Write(" <tr> " & vbCrLf)
Response.Write(" <td>" & app_date & "</td>" & vbCrLf)
Response.Write(" <td>" & log_id & "</td>" & vbCrLf)
Response.Write(" <td>" & app_memo & "</td>" & vbCrLf)
Response.Write(" <td>" & app_name & "</td>" & vbCrLf)
Response.Write(" </tr>" & vbCrLf)
If Not SlmRs.EOF Then
SlmRs.MoveNext()
End If
Loop
End If
If Not SlmRs.EOF Then
SlmRs.MoveNext()
End If
Loop
End If
Slm_Conn = Nothing
SlmRs.Clone()
SlmRs = Nothing
End Sub
#Region "其他辅助功能"
Function FormatNum(ByVal Num As Integer, ByVal Length As Byte) As String
Dim i As Integer
Dim ExtraStr As String
If Not IsNumeric(Num) Or Not IsNumeric(Length) Then
FormatNum = ""
Exit Function
End If
If Len(CStr(Num)) > CShort(Length) Or Len(CStr(Num)) = CShort(Length) Then
FormatNum = CStr(Num)
Else
ExtraStr = ""
For i = 1 To (CShort(Length) - Len(CStr(Num)))
ExtraStr = ExtraStr & "0"
Next
FormatNum = ExtraStr & CStr(Num)
End If
End Function
#End Region
End Class
转载于:https://www.cnblogs.com/wybshyy/p/5847856.html