Newsgroup: it.comp.lang.visual-basic
Titolo: ?? How to EXPORT DATA GRID data into EXCEL ??

 
I need to figure out if it's possible to export data grid data into
excel.  Any help would be greatly appreciated.
 
phoen...@crosswinds.net


 Here is code for exporting an actual recordset to an excel
 spreadsheet. Thanks goes to Chris Shell.
 Here is the code:
 Private Sub CmdExport_Click()
 'This code exports a recordset to an excel spreadsheet
 Dim x
 Dim xlApp As Excel.Application
 Dim xlBook As Workbook
 Dim xl As Excel.Worksheet
 Dim icols
 Dim expDB As Database
 Dim rs As Recordset
 Dim FldCount As Integer
 Dim rsCount As Integer
 Dim i, k, c, r
 x = MsgBox("This function will export the current records in the
 DBGrid to an Excel sheet, " & _
 "If you do not have Excel an error will occur, do wish to
 continue?", vbYesNo + vbQuestion, "Export Data?")
 If x = vbNo Then Exit Sub
 If IsNull(tmpData.Recordset) Then GoTo NoRS
 Screen.MousePointer = vbHourglass
 'Access Your recordset here it is from as
 'Data control, it does not maatter where it
 'comes from.
 Set rs = lstdb.OpenRecordset(tmpData.RecordSource, dbOpenSnapshot)
 'Declare application
 Set xlApp = CreateObject("Excel.Application")
 'Declare Workbook
 Set xlBook = xlApp.Workbooks.Add(xlWBATWorksheet)
 'Identify worksheet
 Set xl = xlBook.Worksheets(1)
 'Below this code determines the number of columns then
 'labels each column with the appropriate field name.
 'This code can be found in the 'CopyFromRecordSet' function
 'of the Excel Object.
 FldCount = rs.Fields.Count - 1
 'Excel Column counts are kept seperate as fields may be skipped
 c = 1
 For icols = 0 To rs.Fields.Count - 1
 'If the field is a system field then it skips it.
 If rs.Fields(icols).Name Like "s_" & Chr(42) Then GoTo SkipName
 xl.Cells(1, c).Value = rs.Fields(icols).Name
 c = c + 1
 SkipName:
 Next
 xl.Range(xl.Cells(1, 1), xl.Cells(1, rs.Fields.Count)).Font.Bold =
 True
 With rs
 .MoveLast
 .MoveFirst
 rsCount = .RecordCount - 1
 r = 2
 Me.Height = 5970
 'Here I have a statusbar on my form
 Bar1.Min = 0
 Bar1.Max = rsCount
 lblExport.Visible = True
 Bar1.Visible = True
 '4 loops are being performed at once here.
 'Loop 'k' loops through the rows of records and
 'with each row 'r' for the Excel sheet.
 'Inside this loop is another nested loop.
 'Loop 'i' is looping through the Fields and along
 'with i 'c' is moving through the columns.
 'As mentioned above the reason for seperate counts
 'between the recordset and Excel sheet are due to
 'skipping system fields.
 For k = 0 To rsCount
 c = 1
 For i = 0 To FldCount
 If rs.Fields(i).Name Like "s_" & Chr(42) Then GoTo SkipField
 xl.Cells(r, c).Value = rs.Fields(i).Value
 c = c + 1
 SkipField:
 Next 'i
 r = r + 1
 .MoveNext
 Bar1.Value = k
 Next 'k
 End With
 'After loop is complete, show the sheet
 xl.Visible = xlSheetVisible
 xlApp.Visible = True
 Bar1.Visible = False
 lblExport.Visible = False
 Me.Height = 5265
 xlApp.Quit
 Set xl = Nothing
 Set xlBook = Nothing
 Set xlApp = Nothing
 Set rs = Nothing
 Screen.MousePointer = vbDefault
 Exit Sub
 NoRS:
 Screen.MousePointer = vbDefault
 MsgBox "No Active recordset detected"
 Exit Sub
 Exp_Err:
 Screen.MousePointer = vbDefault
 MsgBox Err.Number & ": " & Err.Description
 Resume Next
 End Sub
 design by jK© 1998-1999 jK soft, Jan KUDR