I wrote this procedure to export a datatable to Excel.
It works pretty well, but has a minor problem with closing the instance of
Excel.
Let me know if it works for you and if you have solved the problem!
Public Sub Export2Excel(ByVal dt As DataTable, ByVal strPath As String,
ByRef pb As ProgressBar, ByVal MyOption As String)
'add reference to Microsoft Excel
Dim objXL As Excel.Application
Dim objWBS As Excel.Workbooks
Dim objWB As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim mRow As DataRow
Dim colIndex As Integer
Dim rowIndex As Integer
Dim col As DataColumn
're-set pb so it displays correctly if called again
pb.Value = 0
pb.Minimum = 0
pb.Step = 1
Try
pb.Maximum = dt.Rows.Count
pb.Visible = True
If File.Exists(strPath) Then
File.Delete(strPath)
End If
Try
'get a running instance of Excel - this minimizes the number of instances of
Excel in memory!
objXL = CType(GetObject(, "Excel.Application"), Excel.Application)
Catch ex As Exception
'create a new instance of Excel if there isn't one running.
objXL = New Excel.Application
End Try
objWBS = objXL.Workbooks
objWB = objWBS.Add
objWS = CType(objWB.Worksheets(1), Excel.Worksheet)
'write column headers to Excel's first row from the dt.
For Each col In dt.Columns
colIndex += 1
objWS.Cells(1, colIndex) = col.ColumnName
Next col
If MyOption = "A" Then
'Bold and widen all the column headings
objWS.Range("A1:X1").Font.Bold = True
objWS.Columns.ColumnWidth = 10.5
'make some columns wider than the others
objWS.Range("A:A").ColumnWidth = 17
objWS.Range("C:C").ColumnWidth = 39
objWS.Range("E:F").ColumnWidth = 20
objWS.Range("L:O").ColumnWidth = 20
objWS.Range("T:T").ColumnWidth = 13
'rename the sheet to the file name w/o extension
objWS.Name = Mid(Path.GetFileName(strPath), 1,
Len(Path.GetFileName(strPath)) - 4)
ElseIf MyOption = "B" Then
'Bold and widen all the column headings
objWS.Range("A1:Q1").Font.Bold = True
objWS.Columns.ColumnWidth = 10.5
'make a column wider
objWS.Range("A:A").ColumnWidth = 17
'rename the sheet to B
objWS.Name = "B"
Else
'do nothing
End If
'write data starting on row with column headers because the first step is to
increment to the next row.
rowIndex = 1
For Each mRow In dt.Rows
pb.PerformStep()
rowIndex += 1
colIndex = 0
For Each col In dt.Columns
colIndex += 1
If col.ColumnName = "field1" Or col.ColumnName = "field2" Or col.ColumnName
= "field3" Then
'force to text data by adding a leading apostrophe
objWS.Cells(rowIndex, colIndex) = "'" & mRow(col.ColumnName).ToString()
Else
objWS.Cells(rowIndex, colIndex) = mRow(col.ColumnName).ToString()
End If
Next col
Next mRow
'make all rows same height
objWS.Range("A1:A" & CStr(dt.Rows.Count)).RowHeight = 12.75
objWB.SaveAs(strPath)
objWB.Close()
'minor problem - Excel is staying in Memory even after the Quit. It goes
away when the form is closed.
'if this procedure was local to the form that called it the problem might go
away. Untested.
'partially fixed by using a running instance instead of creating a new one
every time.
'Limited to 1 instance stuck in memory instead of unlimited number.
System.Runtime.InteropServices.Marshal.ReleaseComObject(objWS)
System.Runtime.InteropServices.Marshal.ReleaseComObject(objWB)
System.Runtime.InteropServices.Marshal.ReleaseComObject(objWBS)
objXL.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(objXL)
'this does not work to clear out the Excel instance from memory. Even though
it looks like "just the thing".
'
http://www.dotnetinterop.com/faq/?q=OfficeCleanup
'
http://support.microsoft.com/default.aspx?scid=kb;en-us;317109
'release other objects too! Still does not work. May be the remote call
issue.
Catch exc As Exception
Throw
Finally
objWS = Nothing
objWB = Nothing
objWBS = Nothing
objXL = Nothing
pb.Visible = False
'this does not work to clear out the Excel instance from memory either.
'GC.Collect()
'GC.WaitForPendingFinalizers()
End Try
End Sub
