如何通过ExcelLibrary以正确的格式导出日期列到excel

Question

我使用excelliabary将多个数据表导出到excel文件。问题是所有数据表中的日期列都被导出为数字。数据表用从Sql Server检索到的数据填充，其中列类型为date。数据网格也显示正确，但在excel中它变成了数字。

下面是填充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

，这里是导出数据到Excel

Dim fileName = ExportAllDialog.FileName
datasetForExport.Tables.Add(dt1)
datasetForExport.Tables.Add(dt2)
ExcelLibrary.DataSetHelper.CreateWorkbook(fileName, datasetForExport)

Answer 1

下面是一些Microsoft.Office.Interop.Excel方法的代码:

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

然后你可以使用这个函数来导出你的数据集:

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