📄 excelexport.vb
字号:
Imports System.Text
Imports System.Web
Imports System.Xml
Imports System.Xml.Xsl
Imports System.IO
Imports System.Runtime.InteropServices.Marshal
Public Class ExcelExport
Private Const TEMP_EXCEL_FILE_NAME As String = "ExportedExcel"
Private Const DEFAULT_TEMP_EXCEL_SHEET_NAME As String = "Temp"
Private Const DEFAULT_XSL_FILE As String = ""
Private Const DEFAULT_DISPLAY_COLUMN_HEADER As Boolean = True
Private Const DEFAULT_EXCEL_INDEX As Integer = 1
Private m_strTempFolderName As String
Private m_strTemplateFolderName As String
Private m_strXSLStyleSheetFolderName As String
Protected objExcel As Object
Public Property TempFolder() As String
Get
Dim strPath As String
If m_strTempFolderName = String.Empty Then
strPath = HttpContext.Current.Server.MapPath(HttpContext.Current.Request.ApplicationPath) + "\"
Else
strPath = HttpContext.Current.Server.MapPath(HttpContext.Current.Request.ApplicationPath & m_strTempFolderName)
End If
Return strPath
End Get
Set(ByVal Value As String)
m_strTempFolderName = Value
End Set
End Property
Public Property TemplateFolder() As String
Get
Dim strPath As String
If m_strTemplateFolderName = String.Empty Then
strPath = HttpContext.Current.Server.MapPath(HttpContext.Current.Request.ApplicationPath)
Else
strPath = HttpContext.Current.Server.MapPath(HttpContext.Current.Request.ApplicationPath & m_strTemplateFolderName)
End If
Return strPath
End Get
Set(ByVal Value As String)
m_strTemplateFolderName = Value
End Set
End Property
Public Property XSLStyleSheetFolder() As String
Get
Dim strPath As String
If m_strXSLStyleSheetFolderName = String.Empty Then
strPath = HttpContext.Current.Server.MapPath(HttpContext.Current.Request.ApplicationPath)
Else
strPath = HttpContext.Current.Server.MapPath(HttpContext.Current.Request.ApplicationPath & m_strXSLStyleSheetFolderName)
End If
Return strPath
End Get
Set(ByVal Value As String)
m_strXSLStyleSheetFolderName = Value
End Set
End Property
Public Sub New()
End Sub
Private Function CreateXSL(ByVal dtTable As DataTable, ByVal blnDisplayColumnHeader As Boolean) As String
Dim sbXSL As StringBuilder
Try
sbXSL = New StringBuilder
sbXSL.Append("<xsl:stylesheet xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"" version=""1.0"">")
sbXSL.Append("<xsl:template match=""/"">")
sbXSL.Append("<HTML>")
sbXSL.Append("<HEAD>")
sbXSL.Append("</HEAD>")
sbXSL.Append("<BODY>")
sbXSL.Append("<TABLE>")
sbXSL.Append("<TR>")
If blnDisplayColumnHeader = True Then
For Each dcColumn As DataColumn In dtTable.Columns
sbXSL.Append("<TD>")
sbXSL.Append(dcColumn.ColumnName)
sbXSL.Append("</TD>")
Next
End If
sbXSL.Append("</TR>")
sbXSL.Append("<xsl:for-each select=""NewDataSet/" & dtTable.TableName & """>")
sbXSL.Append("<TR>")
For Each dcColumn As DataColumn In dtTable.Columns
sbXSL.Append("<TD><xsl:value-of select=""")
sbXSL.Append(dcColumn.ColumnName)
sbXSL.Append("""/></TD>")
Next
sbXSL.Append("</TR>")
sbXSL.Append("</xsl:for-each>")
sbXSL.Append("</TABLE>")
sbXSL.Append("</BODY>")
sbXSL.Append("</HTML>")
sbXSL.Append("</xsl:template>")
sbXSL.Append("</xsl:stylesheet>")
Return sbXSL.ToString
Catch exptn As Exception
Throw
Finally
sbXSL = Nothing
End Try
End Function
Public Overloads Function TransformDataTableToExcel(ByVal dtTable As DataTable, ByVal blnDisplayColumnHeader As Boolean) As String
Try
Return TransformDataTableToExcel(dtTable, blnDisplayColumnHeader, DEFAULT_XSL_FILE)
Catch exptn As Exception
Throw
End Try
End Function
Public Overloads Function TransformDataTableToExcel(ByVal dtTable As DataTable, ByVal strXSLFile As String) As String
Try
Return TransformDataTableToExcel(dtTable, DEFAULT_DISPLAY_COLUMN_HEADER, strXSLFile)
Catch exptn As Exception
Throw
End Try
End Function
Public Overloads Function TransformDataTableToExcel(ByVal dtTable As DataTable) As String
Try
Return TransformDataTableToExcel(dtTable, DEFAULT_DISPLAY_COLUMN_HEADER, DEFAULT_XSL_FILE)
Catch exptn As Exception
Throw
End Try
End Function
Private Overloads Function TransformDataTableToExcel(ByVal dtTable As DataTable, ByVal blnDisplayColumnHeader As Boolean, ByVal strXSLFile As String) As String
Dim strXSL As String
Dim strXSLTempFile As String
Dim strExcelFile As String
Dim dsDataSet As DataSet
Dim objFsXSL As FileStream
Dim objstrWrtXSL As StreamWriter
Dim objFsXML As System.IO.FileStream
Dim objXmlTxtWrt As XmlTextWriter
Dim objStrRdr As StringReader
Dim objXmlTxtRdr As XmlTextReader
Dim objXPath As XPath.XPathDocument
Dim objXslTran As Xsl.XslCompiledTransform
Dim xslRes As XmlResolver
Try
dsDataSet = New DataSet
dsDataSet.Tables.Add(dtTable.Copy)
If strXSLFile = "" Then
strXSL = CreateXSL(dtTable, blnDisplayColumnHeader)
strXSLTempFile = TempFolder & dtTable.TableName & Now.ToString("MM-dd-yy") & " " & Now.Hour.ToString & Now.Minute.ToString _
& Now.Second.ToString & Now.Millisecond.ToString & ".xsl"
objFsXSL = New FileStream(strXSLTempFile, FileMode.Create)
objstrWrtXSL = New StreamWriter(objFsXSL)
objstrWrtXSL.Write(strXSL)
objstrWrtXSL.Flush()
objstrWrtXSL.Close()
End If
strExcelFile = TempFolder & dtTable.TableName & Now.ToString("MM-dd-yy") & " " & Now.Hour.ToString & Now.Minute.ToString _
& Now.Second.ToString & Now.Millisecond.ToString & ".xls"
'Create Output Stream to write the file to disk
objFsXML = New System.IO.FileStream(strExcelFile, _
System.IO.FileMode.Create)
objXmlTxtWrt = New XmlTextWriter(objFsXML, _
System.Text.Encoding.Unicode)
'Create Xpath Doc to be given as used while doing the XSL Trannsfor
objStrRdr = New StringReader(dsDataSet.GetXml)
objXmlTxtRdr = New XmlTextReader(objStrRdr)
objXPath = New XPath.XPathDocument(objXmlTxtRdr)
objXslTran = New Xsl.XslCompiledTransform
If strXSLFile = "" Then
objXslTran.Load(strXSLTempFile)
Else
strXSLFile.Replace(XSLStyleSheetFolder, "")
strXSLFile = XSLStyleSheetFolder & strXSLFile
objXslTran.Load(strXSLFile)
End If
objXslTran.Transform(objXPath, objXmlTxtWrt)
Return strExcelFile
Catch exptn As Exception
Throw
Finally
strXSL = Nothing
strXSLTempFile = Nothing
dsDataSet = Nothing
If Not objFsXSL Is Nothing Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -