VB icon

Create Excel file using ADOX

Email
Submitted on: 2/6/2015 4:06:00 PM
By: Grzegorz P. (from psc cd)  
Level: Intermediate
User Rating: By 8 Users
Compatibility: VB 6.0
Views: 3702
 
     This sample shows how create Excel file using ADOX. In database apps when ADO and ADOX is used it's simple way to create 'Excel reports'. Using ADOX is about 3 times faster than Excel Automation. If you find this code useful, please vote...
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Create Excel file using ADOX
' Description:This sample shows how create Excel file using ADOX. In database apps when ADO and ADOX is used it's simple way to create 'Excel reports'. Using ADOX is about 3 times faster than Excel Automation. If you find this code useful, please vote...
' By: Grzegorz P. (from psc cd)
'**************************************

Public Function SaveRecordsetAsExcelFile(ByRef SourceRecordset As ADODB.Recordset, _
 ByVal ExcelFileName As String, _
 ByVal WorksheetName As String) As Boolean
 'Don't forget to add reference to Microsoft ADO 2.8 and ADOX 2.8 Libraries
 
 Dim cnnExcel As ADODB.Connection
 Dim catExcel As ADOX.Catalog
 Dim tblWorksheet As ADOX.Table
 Dim rstExcelData As ADODB.Recordset
 Dim fldColumnHeader As ADODB.Field
 Dim strWkshtName As String
On Error GoTo EH_SaveRecordsetAsExcelFile
'Create Excel file and worksheet
Set cnnExcel = New ADODB.Connection
Set catExcel = New ADOX.Catalog
Set tblWorksheet = New ADOX.Table
cnnExcel.CursorLocation = adUseClient
cnnExcel.Provider = "Microsoft.Jet.OLEDB.4.0"
cnnExcel.Properties("Extended Properties") = "Excel 8.0"
cnnExcel.Open "Data Source = " & ExcelFileName
Set catExcel.ActiveConnection = cnnExcel
tblWorksheet.Name = WorksheetName
For Each fldColumnHeader In SourceRecordset.Fields
tblWorksheet.Columns.Append fldColumnHeader.Name, fldColumnHeader.Type
Next 'fldColumnHeader
catExcel.Tables.Append tblWorksheet
Set tblWorksheet = Nothing
Set catExcel = Nothing
Set cnnExcel = Nothing
'Fill worksheet with data
Set cnnExcel = New ADODB.Connection
Set rstExcelData = New ADODB.Recordset
With cnnExcel
.CursorLocation = adUseClient
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties") = "Excel 8.0"
.Open ExcelFileName
strWkshtName = "[" & WorksheetName & "$]"
With rstExcelData
Set .ActiveConnection = cnnExcel
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Source = strWkshtName
.Open
End With 'rstExcelData
With SourceRecordset
.MoveFirst
Do While Not .EOF
rstExcelData.AddNew
For Each fldColumnHeader In .Fields
rstExcelData.Fields(fldColumnHeader.Name) = fldColumnHeader 'insert value
Next 'fldColumnHeader
rstExcelData.Update
.MoveNext
Loop
End With 'SourceRecordset
.Close 'cnnExcel
End With 'cnnExcel
Set cnnExcel = Nothing
Set rstExcelData = Nothing
Set fldColumnHeader = Nothing
SaveRecordsetAsExcelFile = True
Exit Function
EH_SaveRecordsetAsExcelFile:
SaveRecordsetAsExcelFile = False
Set tblWorksheet = Nothing
Set catExcel = Nothing
Set cnnExcel = Nothing
Set rstExcelData = Nothing
Set fldColumnHeader = Nothing
End Function


Other 1 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.