Search Tools Links Login

Create Excel file using ADOX

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...

Original Author: Grzegorz P.


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
    End With 'rstExcelData
    With SourceRecordset
      Do While Not .EOF
          For Each fldColumnHeader In .Fields
            rstExcelData.Fields(fldColumnHeader.Name) = fldColumnHeader 'insert value
          Next 'fldColumnHeader
    End With 'SourceRecordset
    .Close 'cnnExcel
  End With 'cnnExcel
  Set cnnExcel = Nothing
  Set rstExcelData = Nothing
  Set fldColumnHeader = Nothing
  SaveRecordsetAsExcelFile = True
Exit Function
  SaveRecordsetAsExcelFile = False
  Set tblWorksheet = Nothing
  Set catExcel = Nothing
  Set cnnExcel = Nothing
  Set rstExcelData = Nothing
  Set fldColumnHeader = Nothing
End Function

About this post

Posted: 2003-06-01
By: ArchiveBot
Viewed: 268 times


Visual Basic 6


No attachments for this post

Loading Comments ...


No comments have been added for this post.

You must be logged in to make a comment.