|
|
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
objFsXSL.Close()
objFsXSL = Nothing
End If
If Not objstrWrtXSL Is Nothing Then
objstrWrtXSL.Close()
objstrWrtXSL = Nothing
End If
If Not objXmlTxtWrt Is Nothing Then
objXmlTxtWrt.Close()
objXmlTxtWrt = Nothing
End If
If Not objFsXML Is Nothing Then
objFsXML.Close()
objFsXML = Nothing
End If
If Not objStrRdr Is Nothing Then
objStrRdr.Close()
objStrRdr = Nothing
End If
If Not objXmlTxtRdr Is Nothing Then
objXmlTxtRdr.Close()
objXmlTxtRdr = Nothing
End If
objXPath = Nothing
objXslTran = Nothing
xslRes = Nothing
End Try
End Function
Public Function TransformXMLDocumentToExcel(ByVal XMLDoc As XmlDataDocument, ByVal strXSLFullFilePath As String) As String
Dim strExcelFile As String
Dim objStrRdr As StringReader
Dim objXMLRdr As XmlTextReader
Dim objXPthDoc As XPath.XPathDocument
Dim fs As System.IO.FileStream
Dim objXMLTxtWrtr As XmlTextWriter
Dim objXslTran As XslCompiledTransform
Dim objXslRes As XmlResolver
Try
'Create An Xpath Doc
objStrRdr = New StringReader(XMLDoc.OuterXml)
objXMLRdr = New XmlTextReader(objStrRdr)
objXPthDoc = New XPath.XPathDocument(objXMLRdr)
strExcelFile = TempFolder & TEMP_EXCEL_FILE_NAME & Now.ToString("MM-dd-yy") & " " & Now.Hour.ToString & Now.Minute.ToString _
& Now.Second.ToString & Now.Millisecond.ToString & ".xls"
fs = New System.IO.FileStream(strExcelFile, _
System.IO.FileMode.Create)
'Create an XmlTextWriter for the FileStream.
objXMLTxtWrtr = New XmlTextWriter(fs, _
System.Text.Encoding.Unicode)
'Transform the XML using the stylesheet.
objXslTran = New XslCompiledTransform
strXSLFullFilePath = strXSLFullFilePath.Replace(XSLStyleSheetFolder, "")
strXSLFullFilePath = XSLStyleSheetFolder & strXSLFullFilePath
objXslTran.Load(strXSLFullFilePath)
objXslTran.Transform(objXPthDoc, objXMLTxtWrtr)
Return strExcelFile
Catch exptn As Exception
Throw
Finally
If Not objXMLTxtWrtr Is Nothing Then
objXMLTxtWrtr.Close()
objXMLTxtWrtr = Nothing
End If
If Not objStrRdr Is Nothing Then
objStrRdr.Close()
objStrRdr = Nothing
End If
If Not objXMLRdr Is Nothing Then
objXMLRdr.Close()
objXMLRdr = Nothing
End If
If Not fs Is Nothing Then
fs.Close()
fs = Nothing
End If
If Not objXMLTxtWrtr Is Nothing Then
objXMLTxtWrtr.Close()
objXMLTxtWrtr = Nothing
End If
objXPthDoc = Nothing
objXslTran = Nothing
objXslRes = Nothing
End Try
End Function
Public Overloads Function AddExcelSheetToExcelTemplate(ByVal strExcelFile As String, ByVal strExcelTemplate As String) As String
Try
Return AddExcelSheetToExcelTemplate(strExcelFile, strExcelTemplate, DEFAULT_EXCEL_INDEX, DEFAULT_TEMP_EXCEL_SHEET_NAME)
Catch exptn As Exception
Throw
End Try
End Function
Public Overloads Function AddExcelSheetToExcelTemplate(ByVal strExcelFile As String, ByVal strExcelTemplate As String, ByVal strExcelSheetName As String) As String
Try
Return AddExcelSheetToExcelTemplate(strExcelFile, strExcelTemplate, DEFAULT_EXCEL_INDEX, strExcelSheetName)
Catch exptn As Exception
Throw
End Try
End Function
Public Overloads Function AddExcelSheetToExcelTemplate(ByVal strExcelFile As String, ByVal strExcelTemplate As String, ByVal intIndexOfExcelSheetToBeCopied As Integer) As String
Try
Return AddExcelSheetToExcelTemplate(strExcelFile, strExcelTemplate, intIndexOfExcelSheetToBeCopied, DEFAULT_TEMP_EXCEL_SHEET_NAME)
Catch exptn As Exception
Throw
End Try
End Function
Public Overloads Function AddExcelSheetToExcelTemplate(ByVal strExcelFile As String, ByVal strExcelTemplate As String, ByVal intIndexOfExcelSheetToBeCopied As Integer, ByVal strExcelSheetName As String) As String
Dim objBooks As Object
Dim objBook As Object
Dim objSheets As Object
Dim objSheet As Object
Dim strFinalExcelFile As String
Try
Dim objtest As Type
objtest = Type.GetTypeFromProgID("Excel.Application")
objExcel = Activator.CreateInstance(objtest)
'objExcel = New Excel.Application
objExcel.Visible = False : objExcel.DisplayAlerts = False
strExcelTemplate = strExcelTemplate.Replace(TemplateFolder, "")
strExcelFile = strExcelFile.Replace(TempFolder, "")
objBooks = objExcel.Workbooks
objBooks.Open(TemplateFolder & strExcelTemplate)
objBooks.Open(TempFolder & strExcelFile)
strFinalExcelFile = TempFolder & strExcelTemplate.Replace(".xls", "") & Now.ToString("MM-dd-yy") & " " & Now.Hour.ToString & Now.Minute.ToString _
& Now.Second.ToString & Now.Millisecond.ToString & ".xls"
objBooks.Item(1).SaveAs(strFinalExcelFile)
objBooks.Item(2).Worksheets.Item(intIndexOfExcelSheetToBeCopied).copy(objBooks.Item(1).Worksheets.Item(1))
objBooks.Item(1).Worksheets.Item(1).Name = strExcelSheetName
objBooks.Item(2).Close()
objBooks.Item(1).Save()
objBooks.Item(1).Close()
objExcel.Quit()
Return strFinalExcelFile
Catch exptn As Exception
Throw
Finally
ReleaseComObject(objExcel)
ReleaseComObject(objBooks)
objExcel = Nothing
objBooks = Nothing
objBook = Nothing
objSheets = Nothing
objSheet = Nothing
System.GC.Collect()
End Try
End Function
Public Sub SendExcelToClient(ByVal strExcelFile As String)
Try
HttpContext.Current.Response.Clear()
HttpContext.Current.Response.AddHeader("content-disposition", "attachment;filename=NewFile.xls")
HttpContext.Current.Response.Charset = ""
HttpContext.Current.Response.ContentType = "application/vnd.xls"
HttpContext.Current.Response.WriteFile(strExcelFile)
HttpContext.Current.Response.End()
Catch exptn As Exception
Throw
End Try
End Sub
Public Sub CleanUpTemporaryFiles()
Dim strFile As String
Try
If TempFolder <> HttpContext.Current.Server.MapPath(HttpContext.Current.Request.ApplicationPath) Then
For Each strFile In Directory.GetFiles(TempFolder)
If File.GetLastAccessTime(strFile) < DateTime.Now.AddMinutes(600) Then
File.Delete(strFile)
End If
Next
End If
Catch exptn As Exception
Throw
End Try
End Sub
End Class
|
By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.
If a file you wish to view isn't highlighted, and is a text file (not binary), please
let us know and we'll add colourisation support for it.
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.
Submit an article or tip