Dot Net KB

Export dataset into Excel with unicode support using xml

I want to export dataset data into excel with number, date format support, but I do not want to install Excel in my server. I donot have the licences. here is the code for you. the following code use xml to handle the excel.

Download Source Code here

Imports Microsoft.VisualBasic
Imports System.Data
Imports System.IO

Public Class WorkBookEngine

    Public Sub CreateWorkbook(ByVal dt As DataTable, ByVal Filename As String)
        Dim sw1 As New StreamWriter(Filename)
        Dim tw1 As TextWriter = DirectCast(sw1, TextWriter)
        tw1.WriteLine(CreateWorkbook(dt))
        tw1.Close()
        sw1.Close()
    End Sub

    Public Function CreateWorkbook(ByVal dt As DataTable) As String
        Dim xmlString As String = ""
        If dt IsNot Nothing Then
            xmlString = WriteExcelHeader()
            xmlString = xmlString + WriteStyles()
            xmlString = xmlString + WriteExcelWorkSheet(dt)
            xmlString = xmlString + WriteExcelFooter()
        End If
        Return (xmlString)
    End Function

    Public Sub CreateWorkbook(ByVal ds As DataSet, ByVal Filename As String)
        Dim sw1 As New StreamWriter(Filename)
        Dim tw1 As TextWriter = DirectCast(sw1, TextWriter)
        tw1.WriteLine(CreateWorkbook(ds))
        tw1.Close()
        sw1.Close()
    End Sub

    ' you could have other overloads if you want to get creative...
    Public Function CreateWorkbook(ByVal ds As DataSet) As String
        Dim xmlString As String = ""
        If ds IsNot Nothing Then
            If ds.Tables.Count > 0 Then
                xmlString = WriteExcelHeader()

                For Each dt As DataTable In ds.Tables
                    xmlString = xmlString + WriteExcelWorkSheet(dt)
                Next


                xmlString = xmlString + WriteExcelFooter()
            End If
        End If

        Return (xmlString)
    End Function

    Private Function WriteExcelWorkSheet(ByVal dt As DataTable) As String
        Dim xmlString As New StringBuilder
        xmlString.AppendLine("<Worksheet ss:Name=""" + dt.TableName + """>" + Environment.NewLine + "<Table x:FullColumns=""1"" x:FullRows=""1"">")

        xmlString.AppendLine("<Row>")
        For Each dc As DataColumn In dt.Columns
            xmlString.AppendLine("<Cell><Data ss:Type=""String"">" + dc.ColumnName + "</Data></Cell>")
        Next
        xmlString.AppendLine("</Row>")

        For Each dr As DataRow In dt.Rows
            xmlString.AppendLine("<Row>")
            For Each o As Object In dr.ItemArray
                If IsNumeric(o) Then
                    xmlString.AppendLine("<Cell><Data ss:Type=""Number"">" + o.ToString() + "</Data></Cell>")
                    'ElseIf IsDate(o) Then
                ElseIf TypeOf (o) Is Date Then
                    xmlString.AppendLine("<Cell ss:StyleID=""s21""><Data ss:Type=""DateTime"">" + CType(o, Date).ToString("yyyy-MM-ddTHH:MM:ss.000") + "</Data></Cell>")
                Else
                    xmlString.AppendLine("<Cell><Data ss:Type=""String"">" + o.ToString() + "</Data></Cell>")
                End If
            Next
            xmlString.AppendLine("</Row>")
        Next
        xmlString.AppendLine("</Table></Worksheet>")

        Return (xmlString.ToString)
    End Function

    Private Function WriteStyles() As String
        Dim sb As New StringBuilder
        sb.AppendLine("<Styles>")
        sb.AppendLine("<Style ss:ID=""s21"">")
        sb.AppendLine("<NumberFormat ss:Format=""[ENG][$-409]d\-mmm\-yyyy;@""/>")
        sb.AppendLine("</Style>")
        sb.AppendLine("</Styles>")
        Return sb.ToString
    End Function

    Private Function WriteExcelHeader() As String
        Return ("<?xml version=""1.0"" encoding=""utf-16""?>" + Environment.NewLine + "<Workbook xmlns:msxsl=""urn:schemas-microsoft-com:xslt"" xmlns:user=""urn:my-scripts"" xmlns=""urn:schemas-microsoft-com:office:spreadsheet"" xmlns:o=""urn:schemas-microsoft-com:office:office"" xmlns:x=""urn:schemas-microsoft-com:office:excel"" xmlns:ss=""urn:schemas-microsoft-com:office:spreadsheet"" xmlns:html=""http://www.w3.org/TR/REC-html40""> " + Environment.NewLine)

    End Function
    Private Function WriteExcelFooter() As String
        Return ("</Workbook>" + Environment.NewLine)

    End Function
End Class

1/25/2008 2:25:14 AM Published by FengLiN Category ASP.NET Comments 0 Views (468)
Name

Web site

Are you human? Enter the verify code below.

Comment