strongd
asked on
DATAGRID data to excel
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
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.
I prefer to give the link instead of the code. There important text surrounding the code that the asker may find usefull.
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.Applic ation")
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
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.Applic
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
ASKER
These all work but emoreau was first to respond, therefore he gets the point...
Sorry it took me so long to get back...
Sorry it took me so long to get back...
--------------------------
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.Applic
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.CurrentReg
xlApp.Selection.CurrentReg
' 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