Try this. Also make sure you have the Microsoft Excel Object Library selected in your project references (as well as ADO).
Option Explicit
Dim xlApp As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Private Sub Command0_Click()
Dim strTargetRange As String
Dim strOutputpath As String
Dim strOutputFile As String
Dim strSourceDB As String
Dim strSourceTable As String
strSourceDB = "C:\WINNT\Profiles\emutidjo\desktop\db2.mdb"
strSourceTable = "Award"
strTargetRange = "B3"
strOutputpath = "C:\WINNT\Profiles\emutidjo\desktop\"
strOutputFile = "AwardTable2Excel"
ADOImportFromAccessTable strSourceDB, strSourceTable, strTargetRange, strOutputpath, strOutputFile
' ADOImportFromAccessTable "C:\WINNT\Profiles\emutidjo\desktop\db2.mdb", "AWARD", strTargetRange
End Sub
Sub ADOImportFromAccessTable(DBFullName As String, _
TableName As String, _
strTargetRange As String, _
strOutputpath As String, _
strOutputFilename As String)
Dim ExcelWasNotRunning As Boolean
Dim TargetRange As Excel.Range
' Test to see if there is a copy of Microsoft Excel already running.
On Error Resume Next ' Defer error trapping.
' Getobject function called without the first argument returns a
' reference to an instance of the application. If the application isn't
' running, an error occurs.
Set xlApp = GetObject(, "Excel.Application"

If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.
On Error GoTo err_handler ' capture any new errors
If ExcelWasNotRunning Then
Set xlApp = CreateObject("Excel.application"

End If
' Set the next line to false if you don't want to watch
xlApp.Visible = True
If xlApp.Workbooks.Count > 0 Then
'if there are any workbooks, select the first one.
Set xlwb = xlApp.Workbooks(1)
xlwb.Select
Else
' otherwise create a new wb
Set xlwb = xlApp.Workbooks.Add
End If
If xlwb.Sheets.Count > 0 Then
' iff there are any sheets in the wb, select first one
Set xlSheet = xlwb.Sheets(1)
xlSheet.Select
Else
' otherwise create a worksheet
Set xlSheet = xlwb.Worksheets.Add
xlSheet.Name = "Sheet1"
End If
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
' Set the Range object
Set TargetRange = xlSheet.Range(strTargetRange)
TargetRange.Select
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
.Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable ' all records
For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next
TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data
End With
err_exit:
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
If cn.State = adStateOpen Then cn.Close
Set cn = Nothing
'if you want to save the imported file, just uncomment the next line
'xlwb.SaveAs strOutputpath & strOutputFilename
'close the work book, uncomment out next 2 if you don't want to leave Excel open
' don't forget to set xlApp.visible to true if to be left open.
'xlwb.Close False
'xlApp.Quit
Exit Sub
err_handler:
Resume err_exit
End Sub
Mark