Question

利用VB.NET实现导出DataTable数据到excel中，各位大侠帮帮忙，最好有源码，谢谢，江湖救急

Answer 1

刚好写了个Helper类，你试验一下DataTable2Exce(这个方法代码如下：
Imports System.IO
Imports System.Data
Imports System.Data.OleDb

Public MustInherit Class ExcelHelper
Private Shared Function buildConnStr(excelFilePath As String) As String
Dim excelFileInfo As New System.IO.FileInfo(excelFilePath)
Dim constr As String
If excelFileInfo.Extension = ".xlsx" Then
constr = String.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0};Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=1'", excelFilePath)
Else
constr = String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'", excelFilePath)
End If
Return constr
End Function
'将datatable导入到excel
Public Shared Function DataTable2Excel(dt As DataTable, excelFilePath As String) As Boolean
If File.Exists(excelFilePath) Then
Throw New Exception("该文件已经存在！")
End If
If dt.TableName.Trim.Length = 0 Or dt.TableName.ToLower = "table" Then
dt.TableName = "Sheet1"
End If
Dim colCount As Integer = dt.Columns.Count
Dim pa(colCount - 1) As OleDb.OleDbParameter
Dim tableStructStr As String = "Create Table " & dt.TableName & "("
Dim connString As String = buildConnStr(excelFilePath)
Dim objconn As New OleDbConnection(connString)
Dim objcmd As New OleDbCommand
objcmd.Connection = objconn
Dim dataTypeList As New ArrayList
dataTypeList.Add("System.Decimal")
dataTypeList.Add("System.Double")
dataTypeList.Add("System.Int16")
dataTypeList.Add("System.Int32")
dataTypeList.Add("System.Int64")
dataTypeList.Add("System.Single")
Dim i As Integer = 0
For Each col As DataColumn In dt.Columns
If dataTypeList.IndexOf(col.GetType.ToString) > 0 Then
pa(i) = New OleDbParameter("@" & col.ColumnName, OleDbType.Double)
objcmd.Parameters.Add(pa(i))
If i + 1 = colCount Then
tableStructStr += col.ColumnName + " double)"
Else
tableStructStr += col.ColumnName + " double,"
End If
Else
pa(i) = New OleDbParameter("@" & col.ColumnName, OleDbType.VarChar)
objcmd.Parameters.Add(pa(i))
If i + 1 = colCount Then
tableStructStr += col.ColumnName + " VarChar)"
Else
tableStructStr += col.ColumnName + " VarChar,"
End If
End If
i += 1
Next
Try
objcmd.CommandText = tableStructStr
If objconn.State = ConnectionState.Closed Then objconn.Open()
objcmd.ExecuteNonQuery()
Catch ex As Exception
Throw ex
End Try
Dim InsertSql_1 As String = "Insert into " + dt.TableName + " ("
Dim InsertSql_2 As String = " Values ("
Dim InsertSql As String = ""
For colID As Integer = 0 To colCount - 1 Step 1
If colID + 1 = colCount Then
InsertSql_1 += dt.Columns(colID).ColumnName & ")"
InsertSql_2 += "@" + dt.Columns(colID).ColumnName + ")"
Else
InsertSql_1 += dt.Columns(colID).ColumnName + ","
InsertSql_2 += "@" + dt.Columns(colID).ColumnName + ","
End If
Next
InsertSql = InsertSql_1 + InsertSql_2
For rowID As Integer = 0 To dt.Rows.Count - 1 Step 1
For colID = 0 To dt.Columns.Count - 1
If pa(colID).DbType = DbType.Double And dt.Rows(rowID)(colID).ToString.Trim = "" Then
pa(colID).Value = 0
Else
pa(colID).Value = dt.Rows(rowID)(colID).ToString.Trim
End If
Next
Try
objcmd.CommandText = InsertSql
objcmd.ExecuteNonQuery()
Catch ex As Exception
Throw ex
End Try
Next
Try
If objconn.State = ConnectionState.Open Then objconn.Close()
Catch exp As Exception
Throw exp
End Try
Return True
End Function
' 获取Excel文件数据表列表Sheets
Public Shared Function GetExcelTables(ExcelFileName As String) As ArrayList
'Dim sheets As New List(Of String)
'conn.Open()
'Dim dt As DataTable = conn.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, Nothing)
'For Each r In dt.Rows
' sheets.Add(r("TABLE_NAME"))
'Next
'conn.Close()
'Return sheets
Dim dt As DataTable
If Not File.Exists(ExcelFileName) Then
Throw New Exception("指定的Excel文件不存在")
Return Nothing
End If
Dim tableList As New ArrayList
Using conn As OleDbConnection = New OleDbConnection(buildConnStr(ExcelFileName))
Try
conn.Open()
dt = conn.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, New Object() {Nothing, Nothing, Nothing, "TABLE"})
Catch ex As Exception
Throw ex
End Try
For i As Integer = 0 To dt.Rows.Count - 1
Dim tableName As String = dt.Rows(i)(2).ToString.Trim.TrimEnd("$")
If tableList.IndexOf(tableName) < 0 Then tableList.Add(tableName)
Next
End Using
Return tableList
End Function
'将Excel文件导出至DataTable(第一行作为表头)
Public Shared Function InputFromExcel(ExcelFileName As String, TableName As String) As DataTable
If Not File.Exists(ExcelFileName) Then
Throw New Exception("指定的Excel文件不存在")
End If
Dim tableList As ArrayList = GetExcelTables(ExcelFileName)
If tableList.IndexOf(TableName) < 0 Then
TableName = tableList(0).ToString.Trim
End If
Dim dt As New DataTable
Dim conn As New OleDbConnection(buildConnStr(ExcelFileName))
Dim cmd As New OleDbCommand("select * from [" & TableName & "$]", conn) '调试是否需要$
Dim adapter As New OleDbDataAdapter(cmd)
Try
If conn.State = ConnectionState.Closed Then conn.Open()
adapter.Fill(dt)
Catch ex As Exception
Throw ex
Finally
If conn.State = ConnectionState.Open Then conn.Close()
End Try
Return dt
End Function
'查询excel文件中的一个数据
Public Shared Function ReadOneDataFromExcel(ExcelFileName As String, TableName As String, sql As String) As Object
If Not File.Exists(ExcelFileName) Then
Throw New Exception("指定的Excel文件不存在")
End If
Dim tableList As ArrayList = GetExcelTables(ExcelFileName)
If tableList.IndexOf(TableName) < 0 Then
TableName = tableList(0).ToString.Trim
End If
Dim dt As New DataTable
Dim conn As New OleDbConnection(buildConnStr(ExcelFileName))
Dim cmd As New OleDbCommand(sql, conn) '调试是否需要$
Dim ret As Object
Try
If conn.State = ConnectionState.Closed Then conn.Open()
ret = cmd.ExecuteScalar()
Catch ex As Exception
Throw ex
Finally
If conn.State = ConnectionState.Open Then conn.Close()
End Try
Return ret
End Function
'获取Excel文件指定数据表的数据列表columnNames
Public Shared Function GetExcelTableColumns(ExcelFileName As String, TableName As String) As ArrayList
Dim dt As DataTable
If Not File.Exists(ExcelFileName) Then
Throw New Exception("指定的Excel文件不存在")
Return Nothing
End If
Dim ColList As New ArrayList
Using conn As OleDbConnection = New OleDbConnection(buildConnStr(ExcelFileName))
Try
conn.Open()
dt = conn.GetOleDbSchemaTable(OleDbSchemaGuid.Columns, New Object() {Nothing, Nothing, TableName, Nothing})
Catch ex As Exception
Throw ex
End Try
For i As Integer = 0 To dt.Rows.Count - 1
Dim ColName = dt.Rows(i)("Column_Name").ToString().Trim()
ColList.Add(ColName)
Next
End Using
Return ColList
End Function

End Class

Answer 2

Public Shared Function ExportExceldr(ByVal Drv As DataTable, ByVal ECode As String) As Boolean
Dim BOO As Boolean = False '定义执行结果状态
If Drv Is Nothing OrElse Drv.Rows.Count = 0 Then '没有数据直接返回
Return BOO
End If
Dim SaveFileDialog1 As New SaveFileDialog '实例化文件保存提示框
SaveFileDialog1.Filter = "文件(*.xls)|*.xls" '设置保存文件类型
SaveFileDialog1.FileName = ECode '默认文件名
SaveFileDialog1.FilterIndex = 1 '默认筛选
SaveFileDialog1.InitialDirectory = Application.StartupPath '默认当前路径
If SaveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then '用户点了确认
Try
Dim m_image As String = SaveFileDialog1.FileName '保存Excel路径和文件名称
Dim xlApp As Excel.Application = CreateObject("Excel.Application") '定义Excel对象
Dim xlBook As Excel.Workbook = xlApp.Workbooks.Add() '新增工作簿
Dim sheet As Excel.Worksheet = xlBook.Worksheets(1) '定义工作表
Dim col As Integer = 0 '定义列
Dim row As Integer = 0 '定义行
Dim satData(,) As Object = New Object(Drv.Rows.Count, col) {} '定义二维数组给工作表赋值
For Each dl As DataColumn In Drv.Columns '按列开始循环赋值
row = 0 '行每次从0开始
ReDim Preserve satData(Drv.Rows.Count, col) '重新定义数据
satData(row, col) = dl.ColumnName '赋值列标题
For Each dr As DataRow In Drv.Rows '按行循环
row += 1 '下一行
satData(row, col) = dr(dl.ColumnName) '赋值表内容
Next
col += 1 '下一列
Next
row += 1 '再增加一行，因为包含标题行
sheet.Range(sheet.Cells(1, 1), sheet.Cells(row, col)).Value2 = satData '数组赋值到工作表区域
sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, col)).Font.Bold = True '标题行字体加粗
With sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, col))
.Interior.ColorIndex = 34 '标题行加颜色
.Borders.LineStyle = 1 '加边框
.HorizontalAlignment = 3 '水平居中
.Font.Size = 10 '字体大小
.EntireColumn.AutoFit() '自动调整列宽
End With
sheet.Cells(2, 2).Activate() '激活单元格
sheet.Cells(2, 2).Application.ActiveWindow.FreezePanes = True '固定窗口
If xlBook.Sheets.Count > 1 Then
For i = xlBook.Sheets.Count To 2 Step -1
xlApp.DisplayAlerts = False
CType(xlBook.Worksheets(i), Excel.Worksheet).Delete() '删除多余工作表
Next
End If
xlBook.SaveAs(Filename:=m_image) '保存工作簿
xlApp.Visible = True '可以显示出来了
xlBook = Nothing '释放xlBook
xlApp = Nothing '释放xlApp对象
GC.Collect() '垃圾回收
Catch ex As Exception
MessageBox.Show(ex.ToString)
BOO = True
End Try
GC.Collect()
End If
Return BOO
End Function

Answer 3

. 我想你，不对，让我更正一下，我想念曾经的你，想念那个曾经会关心我的你。

Answer 4

给个实例图片，我来帮你写