Link to home
Start Free TrialLog in
Avatar of Michael_D
Michael_DFlag for Canada

asked on

how to create excel using ado

Hi Experts,


I want to create Excel workbook / worksheet  on the fly using ADO (NOT EXCEL OBJECT LIBRARY)
I know how to read/write from/to existing file. The question is how to create a NEW file.

I have tried this code to access directory where I want to create the file:

Dim oConn As ADODB.Connection
Dim rstSchema As ADODB.Recordset

' Create and open a new ADO Connection
Set oConn = New ADODB.Connection
oConn.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
           "FIL=excel 8.0;" & _
           "DefaultDir=C:\TEMP;" & _
           "MaxBufferSize=2048;" & _
           "PageTimeout=5;"
   
   Set rstSchema = oConn.OpenSchema(adSchemaCatalogs)
   
   Do Until rstSchema.EOF
      Debug.Print "Catalog name: " & _
         rstSchema!Catalog_NAME & vbCr & _
         "DEscription: " & rstSchema!Description & vbCr
      rstSchema.MoveNext
   Loop


This code allowed me to view all Xls files in the given directory. But  rstSchema  is Read only so I can't use rstSchema.Add method.


Any ideas?  

Thank you,


Michael
ASKER CERTIFIED SOLUTION
Avatar of leonstryker
leonstryker
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Michael_D

ASKER

Great! Thank you Leon!

Np.  Thanks for the grade,

Leon
Leon,

It was too good to be right :(

I got an error (-2147217859 Type is invalid.) when trying to add new "table" to "catalog"

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 Micros
    '     oft 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

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' Next Line Generate an error

    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



Did you test this code?
>>Did you test this code?

No.  I alway create Excel using Excel Object Library.  However, I know other people have used this code before with no problems.