Solved

DATAGRID data to excel

Posted on 2004-09-28
6
293 Views
Last Modified: 2008-02-20
How do I take the data in my datagrid1 control and export it to an instance of excel?

I am using VB 6.

I know someone has done this and I would rather not reinvent the wheel.  Please copy and paste you code on here so I can try it.  

Thanks

0
Comment
Question by:strongd
6 Comments
 
LVL 69

Accepted Solution

by:
Éric Moreau earned 250 total points
ID: 12171389
If you have a DataGrid, you surely have a recordset!

See http://support.microsoft.com/default.aspx?scid=kb;en-us;246335&Product=vb6
0
 
LVL 4

Expert Comment

by:Rick_Townsend
ID: 12171466
What version of Excel do you have?  If you have Excel 2000 (or higher, I guess), there is a direct export available to you.  Here's an example method from one of my financial apps, we got the source straight from MSDN.  It will work for both Excel 2000+, and Excel 2000-.  It's just slower and less elegant for older Excel versions.

---------------------------

Private Sub SaveAsExcel(Visible As Boolean, Optional FileName As String)
    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object

    Dim recArray As Variant
   
    Dim strDB As String
    Dim fldCount As Integer
    Dim recCount As Long
    Dim iCol As Integer
    Dim iRow As Integer
   
   
    ' Create an instance of Excel and add a workbook
    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Sheet1")
 
    ' Display Excel and give user control of Excel's lifetime
    xlApp.Visible = Visible
    xlApp.UserControl = Visible
   
    ' Copy field names to the first row of the worksheet
'***See that you can put in your own headers, or use the names of the fields from your recordset.
    fldCount = rst.Fields.count
    xlWs.Cells(1, 1) = "Date Created: " & Date
    xlWs.Cells(2, 1) = "Selection Criteria: " & gSelection
    xlWs.Cells(3, 1) = "Sort Order: " & gOrderBy
    For iCol = 1 To fldCount
        xlWs.Cells(5, iCol).Value = rst.Fields(iCol - 1).Name
    Next
       
    ' Check version of Excel
    If val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
        'EXCEL 2000 or 2002: Use CopyFromRecordset
         
        ' Copy the recordset to the worksheet, starting in cell A2
        xlWs.Cells(7, 1).CopyFromRecordset rst
        'Note: CopyFromRecordset will fail if the recordset
        'contains an OLE object field or array data such
        'as hierarchical recordsets
       
    Else
        'EXCEL 97 or earlier: Use GetRows then copy array to Excel

        ' Copy recordset to an array
        recArray = rst.GetRows
        'Note: GetRows returns a 0-based array where the first
        'dimension contains fields and the second dimension
        'contains records. We will transpose this array so that
        'the first dimension contains records, allowing the
        'data to appears properly when copied to Excel

        ' Determine number of records

        recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array


        ' Check the array for contents that are not valid when
        ' copying the array to an Excel worksheet
        For iCol = 0 To fldCount - 1
            For iRow = 0 To recCount - 1
                ' Take care of Date fields
                If IsDate(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = Format(recArray(iCol, iRow))
                ' Take care of OLE object fields or array fields
                ElseIf IsArray(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = "Array Field"
                End If
            Next iRow 'next record
        Next iCol 'next field

        ' Transpose and Copy the array to the worksheet,
        ' starting in cell A2
        xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = TransposeDim(recArray)
    End If

    ' Auto-fit the column widths and row heights
    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit

    ' Save excel sheet
    CommonDialog1.CancelError = True
    On Error GoTo ErrorHandler
   
    xlWs.SaveAs FileName
    bSaveFlag = True
   
    ' Release Excel references
    Set xlWs = Nothing
    Set xlWb = Nothing
    Set xlApp = Nothing

ErrorHandler:
    'Couldn't save Excel spreadsheet, do some sort of error logging
'***Sensitive lines removed***
End Sub
0
 
LVL 4

Expert Comment

by:Rick_Townsend
ID: 12171484
Ah, emoreau, got the link in there while I was typing.  Guess that will teach me to put the link in first, and then provide actual code after.  Good on ya, anyhow.
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 69

Expert Comment

by:Éric Moreau
ID: 12171609
I prefer to give the link instead of the code. There important text surrounding the code that the asker may find usefull.
0
 
LVL 3

Expert Comment

by:schworak
ID: 12171729
Here is something super generic that should do the trick for you...



Private Sub CopyGridToExcel()
    Dim xl As Object
    Dim wb As Object
    Dim sht As Object
    Dim rs As Object
    Dim ds As Object
    Dim R As Long
    Dim C As Long

    On Error Resume Next
    Set xl = GetObject(, "Excel.Application")
    If Err Then
        Err.Clear
        Set xl = CreateObject("Excel.Application")
    End If
    If Err Then
        MsgBox "Can't get Excel"
        Exit Sub
    End If
    On Error GoTo 0

    xl.Visible = True
    xl.DisplayAlerts = False
    Set wb = xl.Workbooks.Add

    Set sht = wb.sheets(1)
    R = 1
    Set ds = DataGrid1.DataSource
    Set rs = ds.Recordset
    rs.MoveFirst
    Do Until rs.EOF
        For C = 1 To DataGrid1.Columns.Count
            sht.range(Chr(64 + C) & R).Value = DataGrid1.Columns(C - 1).Text
        Next C
        R = R + 1
        rs.MoveNext
    Loop
End Sub
0
 

Author Comment

by:strongd
ID: 12242246
These all work but emoreau  was first to respond, therefore he gets the point...

Sorry it took me so long to get back...

0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now