• VB.NET导出excel并支持中文文件名 中文编码


    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


  • 相关阅读:
    jenkins:用jenkins通过ssh部署jar包到远程linux机器(jdk 15 / jenkins 2.257)
    linux(centos8):安装java jdk 15 (java 15)
    38. 外观数列 迭代
    58. 最后一个单词的长度
    kmp字符串匹配
    单词规律
    1502. 判断能否形成等差数列
    1496. 判断路径是否相交
    1475. 商品折扣后的最终价格
    一维数组的动态和
  • 原文地址:https://www.cnblogs.com/wybshyy/p/16042704.html
Copyright © 2020-2023  润新知