cmq posto il codice

codice:
Su Progetto->Riferimenti devi selezionare Microsoft Excel 9.0 Object o 8.0



Private Sub cmdExport_Click()
On Error GoTo Err_Excel
Dim objXL As Excel.Application
Dim objWB   As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim tmprs As ADODB.Recordset
Dim n As Integer
Dim posizione As Integer
Dim StrSql As String
Screen.MousePointer = vbHourglass
Set objXL = New Excel.Application
Set objWB = objXL.Workbooks.Add
Set objWS = objWB.Worksheets(1)
Set tmprs = New ADODB.Recordset
n = 1
posizione = 1
objWS.Rows("1:1").Font.Bold = True
objWS.Cells(n, posizione).Value = "Pippo" 'Scrivo Pippo nella cella 1:1
posizione = posizione + 1
objWS.Cells(n, posizione).Value = "Pluto" 'Scrivo Pluto nella cella 1:2
posizione = posizione + 1
StrSql = "select  ......." 'select su access dei dati che interessa
tmprs.Open StrSql, DB, adOpenKeyset, adLockOptimistic 
If Not tmprs.EOF And Not tmprs.BOF Then
    tmprs.MoveFirst
    While Not tmprs.EOF
        posizione = 1
        n = n + 1
        objWS.Cells(n, posizione).Value = tmprs!Nome_Campo
        posizione = posizione + 1
        objWS.Cells(n, posizione).Value = tmprs!Nome_Campo1
        tmprs.MoveNext
    Wend
    Screen.MousePointer = vbDefault
    objWS.Cells.EntireColumn.AutoFit
    objWB.SaveAs "C:\Nome_File.xls"
    objWB.Close
    objXL.Quit
    Set objWS = Nothing
    Set objWB = Nothing
    Set objXL = Nothing
    MsgBox "Dati estratti con successo.", vbInformation
Else
    MsgBox "Non ci sono dati da estrarre", vbInformation
End If
Exit Sub
Err_Excel:
Screen.MousePointer = vbDefault
MsgBox "Si è verificato un errore: " & Err.Description, vbCritical, "Errore"
Exit Sub
Resume 0
End Sub
Ciao