Reputation: 225
I am exporting multiple DataTables to an Excel-file using ExcelLiabrary. The problem is that date column in all datatables, are being exported as number. DataTables are filled with data retrieved from Sql Server where the column type is date. Datagrids are also showing it correctly but in the excel it become numbers.
Here is the code to populate DataTable
Dim command = New SqlCommand("getdeta", sqlConn)
command.CommandType =
CommandType.StoredProcedure
Dim adapter = New SqlDataAdapter(command)
dt1 = New DataTable()
adapter.Fill(dt1)
dgv1.DataSource = dt1
and here is to Export data to Excel
Dim fileName = ExportAllDialog.FileName
datasetForExport.Tables.Add(dt1)
datasetForExport.Tables.Add(dt2)
ExcelLibrary.DataSetHelper.CreateWorkbook(fileName, datasetForExport)
Upvotes: 0
Views: 612
Reputation: 1193
So here is some code for the Microsoft.Office.Interop.Excel approach:
Option Strict On
Option Explicit On
Imports System.IO
Imports System.Runtime.InteropServices
Imports Excel = Microsoft.Office.Interop.Excel
Public Class ExcelBook
Private EXL As Excel.Application
Private Book As Excel.Workbook
Private Sheet As Excel.Worksheet
Private MyFileName As String
Protected Overrides Sub Finalize()
' Save and close the currently loaded Excel file
Close(True)
' Delete the local reference to the app BEFORE destroy
EXL = Nothing
MyBase.Finalize()
End Sub
Private Sub OpenApplication()
If EXL IsNot Nothing Then Return
EXL = New Excel.Application
EXL.Visible = False
EXL.DisplayAlerts = False
End Sub
Public Sub Open(Filename As String)
Open(Filename, 1)
End Sub
Public Sub Open(Filename As String, SheetIndex As Object)
OpenApplication()
' If another Excel file is open, close it
Close(True)
If File.Exists(Filename) Then
Book = EXL.Workbooks.Open(Filename)
Else
Book = EXL.Workbooks.Add()
End If
' Turns off warning messages when saving older files
Book.CheckCompatibility = False
UseSheet(SheetIndex)
MyFileName = Filename
End Sub
Public Sub Close(Save As Boolean)
If Book Is Nothing Then Return
If File.Exists(MyFileName) Then
Book.Close(Save)
Else
If Save Then Book.SaveAs(MyFileName)
Book.Close()
End If
Sheet = Nothing
Book = Nothing
MyFileName = Nothing
End Sub
Public Function UseSheet(Index As Object) As Boolean
If Book Is Nothing Then Return False
Try
Sheet = DirectCast(Book.Sheets(Index), Excel.Worksheet)
Sheet.Activate()
Return True
Catch Ex As COMException
Return False
End Try
End Function
Public Sub AddSheet(NewName As String)
AddSheet(NewName, Nothing)
End Sub
Public Sub AddSheet(NewName As String, Before As Object)
If Book Is Nothing Then Return
If SheetExists(NewName) Then Return
If Before Is Nothing OrElse Not SheetExists(Before) Then
Sheet = CType(Book.Sheets.Add(After:=Book.Sheets(Book.Sheets.Count)), Excel.Worksheet)
Else
Sheet = CType(Book.Sheets.Add(Before:=Book.Sheets(Before)), Excel.Worksheet)
End If
Sheet.Activate()
Sheet.Name = NewName
End Sub
Function SheetExists(Index As Object) As Boolean
If Book Is Nothing Then Return False
Dim LocalSheet As Excel.Worksheet
Try
LocalSheet = DirectCast(Book.Sheets(Index), Excel.Worksheet)
Catch Ex As COMException
LocalSheet = Nothing
End Try
Return LocalSheet IsNot Nothing
End Function
Public Sub RenameSheet(NewName As String)
If Sheet Is Nothing Then Return
If Not String.IsNullOrEmpty(NewName) Then Sheet.Name = NewName
End Sub
Public Sub FormatColumns(Columns As String, NewFormat As String)
If Sheet Is Nothing Then Return
Dim Rng = DirectCast(Sheet.Columns(Columns), Excel.Range)
Rng.NumberFormat = NewFormat
End Sub
Public Sub ImportTable(Table As DataTable)
If Sheet Is Nothing Then Return
If Table Is Nothing Then Return
If Table.Columns.Count = 0 Then Return
Dim Matrix(Table.Rows.Count, Table.Columns.Count) As Object
Dim Col As Integer
' Copy the datatable to an array
For Row As Integer = 0 To Table.Rows.Count - 1
For Col = 0 To Table.Columns.Count - 1
Matrix(Row, Col) = Table.Rows(Row).Item(Col)
Next
Next
' Add the column headers starting in A1
Col = 0
For Each Column As DataColumn In Table.Columns
Sheet.Cells(1, Col + 1) = Column.ColumnName
Col += 1
Next
' Add the data starting in cell A2
If Table.Rows.Count > 0 Then
Sheet.Range(Sheet.Cells(2, 1), Sheet.Cells(Table.Rows.Count + 1, Table.Columns.Count)).Value = Matrix
End If
End Sub
End Class
Then you could use this function to export your DataSet:
Private Sub ExportDataSet(DS As DataSet, Filename As String)
Dim DT As DataTable
Dim First As Boolean = True
With New ExcelBook
.Open(Filename)
For Each DT In DS.Tables
If First Then
.RenameSheet(DT.TableName)
First = False
Else
.AddSheet(DT.TableName)
End If
.ImportTable(DT)
Next
.UseSheet(1)
.Close(True)
End With
End Sub
Upvotes: 1