Newsgroup: it.comp.lang.visual-basic
Titolo: ESPORTAZIONE DATABASE SU FILE EXCELL

Cari amici,
Vi sottopongo un problema:
Immaginate di avere, su di un oggetto DataControl (DAO), un recordset
estrapolato da una Query su di un Database Access.
Esiste un modo per trasformarlo direttamante in una Cartella Excell?
Se è possibile mi illustrereste il Codice esatto???
Vi ringrazio.. di cuore...!!!


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