把 DataTable 输出到 excel 文件

''' <summary>

''' 把 DataTable 输出到 excel 文件

''' </summary>

''' <param name="dt_datas">DataTable</param>

''' <param name="excelFileName">excel文件名</param>

''' <returns>返回Excel.Worksheet，以便对其进行后续加工</returns>

''' <remarks></remarks>

Public Function datatableToExcel(dt_datas As DataTable, excelFileName As String) As Excel.Worksheet

　

' 判断这个excel文件是否已经打开了； 如果打开了，不能下载

Try

Dim fs As FileStream = New FileStream(excelFileName, FileMode.OpenOrCreate, FileAccess.Read)

fs.Close()

Catch ex AsException

MessageBox.Show(excelFileName & "文件当前已经打开，请先关闭，否则无法输出")

Return Nothing' 退出

End Try

　

Dim objArray(dt_datas.Rows.Count + 1, dt_datas.Columns.Count) As Object' 准备写入excel表格 的 二维矩阵

' 第0行： 各列的 列头

For jj = 0 To dt_datas.Columns.Count - 1

'objArray(0, jj) = strHeads(jj).Split(".")(1).ToUpper ' 列头 大写

' 上面以前，由于字段名类似于 a.alert_id 这样，所以对其进行拆分，然后取其后一个，但不能处理 alert_id

' 下面现在，对于 a.alert_id（虽然不大可能出现，但是以防万一） 或者 alert_id ，都可处理; 20191118

Dim ss As String() = dt_datas.Columns(jj).Caption.Split(".")

objArray(0, jj) = ss(ss.Length - 1).ToUpper ' 列头 大写

Next

　

' 具体数据

For ii = 0 To dt_datas.Rows.Count - 1

For jj = 0 To dt_datas.Columns.Count - 1

'objArray(ii + 1, jj) = dt_datas.Rows(ii).Item(jj).Value.ToString

' 上面是dgv中的写法，下面是 datatable 的写法

objArray(ii + 1, jj) = dt_datas.Rows(ii).Item(jj).ToString

Next

Next

' 上面统计结束，并写入二维矩阵中

' 下面将二维矩阵输出到excel

Dim excelApplication As New Excel.Application

excelApplication.Visible = False

Dim excelWorkBook As Excel.Workbook = excelApplication.Workbooks.Add()

'Dim excelWorkSheet As Excel.Worksheet = excelWorkBook.Worksheets.Add

'excelWorkSheet.Name = "table0" ' 自己定义的表名；注意 Sheet1\Sheet2\Sheet3是excel文件中自带的三个表名，这里由于是增加新表，所以不能用这三个表名

' 如果上面这行代码被屏蔽（就是没有指定表名），则使用 Sheet4 表名

Dim excelWorkSheet As Excel.Worksheet = excelWorkBook.Worksheets(1) ' 用现有的表名 Sheet1 ，注意 Worksheets 是从1开始

　

' 根据矩阵的大小 设定 excel表格 的 操作区域

Dim range As Microsoft.Office.Interop.Excel.Range = excelWorkSheet.Range("A1").Resize(objArray.GetLength(0), objArray.GetLength(1))

range.NumberFormat = "@"

range.HorizontalAlignment = Excel.XlHAlign.xlHAlignGeneral

range.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter

range.Value = objArray ' 赋值

　

'' 设定 excel 的 单元格大小

With excelWorkSheet

.Cells.RowHeight = 20

.Cells.ColumnWidth = 20

End With

　

Try

excelWorkBook.SaveAs(excelFileName) ' 保存为 excel文件 ， 位置根据配置文件

' 这里以excelFileName文件名进行保存，这个文件总是存在的，会弹出一个对话框，问要不要覆盖

' 用户点击对话框的 Yes 按钮，就会把这个文件覆盖掉，然后在 excel 里打开新的文件

Catch ex AsException' 如果出问题

' 这里出问题的原因就是 用户没有点击 Yes 按钮，而是点击了 No 或者 Cancel 按钮

' 此时可以以其他文件名保存

'MessageBox.Show(excelFileName & " 文件现在无法保存，原因：" & ex.ToString() & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "您可以用其它文件名进行保存，请在接下来的输入框中输入文件名")

'MessageBox.Show(excelFileName & " 文件现在无法保存，您可以用其它文件名进行保存，请在接下来的输入框中输入文件名")

' 在excel文件无法保存的情况下，另外保存

Dim SaveFileDialog1 As System.Windows.Forms.SaveFileDialog = New System.Windows.Forms.SaveFileDialog

SaveFileDialog1.CheckFileExists = False' 不检查文件是否已经存在，似乎无用？

' SaveFileDialog1.Filter = "file excel(*.csv)|*.csv"

' 上面以前，以 csv 作为文件名的后缀，不够灵活

' 下面现在，以 输入文件名的后缀 作为文件名的后缀； 20191118

Dim ss As String() = excelFileName.Split("\") ' 获取文件名（去掉路径信息）

Dim sss As String() = ss(ss.Length - 1).Split(".") ' 获取文件名的后缀

SaveFileDialog1.Filter = "file excel(*." & sss(1) & ")|*." & sss(1)

　

SaveFileDialog1.FilterIndex = 2

SaveFileDialog1.RestoreDirectory = True

If SaveFileDialog1.ShowDialog = System.Windows.Forms.DialogResult.OK Then

excelWorkBook.SaveAs(SaveFileDialog1.FileName) ' 重新起个名字保存

End If

End Try

'MessageBox.Show("Download completed!")

excelApplication.Visible = True

' 收集垃圾，关闭进程

ReleaseComObject(excelApplication)

ReleaseComObject(excelWorkBook)

'ReleaseComObject(excelWorkSheet)

Return excelWorkSheet ' 返回 WorkSheet，以便用户对其进行一些后期处理（比如对某些区域上色等等）

End  Function

' 收集垃圾

Public Sub ReleaseComObject(ByRef obj AsObject)

Try

System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)

obj = Nothing

Catch ex AsException

obj = Nothing

Finally

GC.Collect()

End  Try

End  Sub