ID: Q129304
The information in this article applies to:
Advanced: Requires expert coding, interoperability, and multiuser skills.
This article shows you how to create two user-defined functions for copying records from a Microsoft Access recordset to a Microsoft Excel spreadsheet and printing the updated spreadsheet. The functions use OLE Automation to transfer the data to Microsoft Excel.
This article assumes that you are familiar with Visual Basic for Applications and with creating Microsoft Access applications using the programming tools provided with Microsoft Access. For more information about Visual Basic for Applications, please refer to your version of the "Building Applications with Microsoft Access" manual.
NOTE: Visual Basic for Applications is called Access Basic in version 2.0. For more information about Access Basic, please refer to the "Building Applications" manual.
To take data from a text box on a form and to place it in a cell in an existing Microsoft Excel spreadsheet, formatting the text as bold, follow these steps:
1. Start Microsoft Excel and create a new spreadsheet. Save the spreadsheet
as C:\Access2\Ole_test.xls.
based on any table or query. Create a new text box on the form, and set
the Name property of the text box to ToExcel.
4. Type the following code for the OnClick event procedure of the command
button.
In Microsoft Access 2.0:
Dim mysheet As Object, myfield As Variant
' Set object variable equal to the OLE object.
Set mysheet = GetObject("c:\access2\ole_test.xls", "excel.sheet")
' Put the value of the ToExcel text box into the cell on the
' spreadsheet and make the cell bold.
myfield = Me!ToExcel
mysheet.cells(1, 1).value = myfield
mysheet.cells(1, 1).font.bold = True
' Set the Visible property of the sheet to True, save the
' sheet, and quit Microsoft Excel.
mysheet.application.windows("ole_test.xls").visible = True
mysheet.application.activeworkbook.save
mysheet.application.activeworkbook.[close]
mysheet.application.[quit]
' Clear the object variable.
Set mysheet = Nothing
NOTE: The brackets around the words "close" and "quit" are necessary
to specify that these are Microsoft Excel methods, rather than a
Microsoft Access methods.
In Microsoft Access 7.0:
Dim mysheet As Object, myfield As Variant
' Set object variable equal to the OLE object.
Set mysheet = GetObject("c:\access2\ole_test.xls", "excel.sheet")
' Put the value of the ToExcel text box into the cell on the
' spreadsheet and make the cell bold.
myfield = Me!ToExcel
mysheet.cells(1, 1).Value = myfield
mysheet.cells(1, 1).font.bold = True
' Set the Visible property of the sheet to True, save the
' sheet, and quit Microsoft Excel.
mysheet.Application.windows("ole_test.xls").Visible = True
mysheet.Application.activeworkbook.Save
mysheet.Application.activeworkbook.Close
mysheet.Application.Quit
' Clear the object variable.
Set mysheet = Nothing
In Microsoft Access 97:
Dim mysheet As Object, myfield As Variant, xlApp As Object
' Set object variable equal to the OLE object.
Set xlApp = CreateObject("Excel.Application")
' Set mysheet = GetObject("c:\access2\ole_test.xls", "excel.sheet").
Set mysheet = xlApp.workbooks.Open("c:\access2\ole_test.xls").Sheets(1)
' Put the value of the ToExcel text box into the cell on the
' spreadsheet and make the cell bold.
myfield = Me!ToExcel
mysheet.cells(1, 1).Value = myfield
mysheet.cells(1, 1).font.bold = True
' Set the Visible property of the sheet to True, save the
' sheet, and quit Microsoft Excel.
mysheet.Application.windows("ole_test.xls").Visible = True
mysheet.Application.activeworkbook.Save
mysheet.Application.activeworkbook.Close
xlApp.Quit
' Clear the object variable.
Set mysheet = Nothing
then click the command button.
To create the function for transferring an entire recordset to Microsoft Excel, follow these steps:
1. Open the sample database Northwind.mdb (or NWIND.MDB in version 2.0).
2. Create a new form not based on any table or query.
3. Add a command button to the form and type the following code for the
OnClick event procedure of the command button:
In Microsoft Access 2.0 and 7.0:
Private Sub Command0_Click()
Dim DB As Database, Rs As Recordset
Dim i As Integer, j As Integer
Dim RsSql As String
Dim CurrentValue As Variant
Dim CurrentField As Variant
Dim Sheet As Object
Set DB = DBEngine.Workspaces(0).Databases(0)
' *** Use the following line for Microsoft Access 7.0 only ***
' RsSql = "SELECT * FROM [Order Details] WHERE [OrderId]<10249;"
' *** Use the following line for Microsoft Access 2.0 only ***
' RsSql = "SELECT * FROM [Order Details] WHERE [Order Id]<10001;"
Set Rs = DB.OpenRecordset(RsSql, DB_OPEN_DYNASET)
Set Sheet = CreateObject("Excel.Sheet")
j = 1
' Loop through the Microsoft Access field names and create
' the Microsoft Excel labels.
For i = 0 To Rs.Fields.Count - 1
CurrentValue = Rs.Fields(i).Name
Sheet.cells(j, i + 1).Value = CurrentValue
Next i
j = 2
' Loop through the Microsoft Access records and copy the records
' to the Microsoft Excel spreadsheet.
Do Until Rs.EOF
For i = 0 To Rs.Fields.Count - 1
CurrentField = Rs(i)
Sheet.cells(j, i + 1).Value = CurrentField
Next i
Rs.MoveNext
j = j + 1
Loop
' Print the Microsoft Excel spreadsheet.
Sheet.PrintOut
Set Sheet = Nothing
End Sub
In Microsoft Access 97:
Private Sub Command0_Click()
Dim DB As Database, Rs As Recordset
Dim i As Integer, j As Integer
Dim RsSql As String
Dim CurrentValue As Variant
Dim CurrentField As Variant
Dim Workbook As Object
Dim xlApp As Object
Dim Sheet As Object
Set DB = DBEngine.Workspaces(0).Databases(0)
RsSql = "SELECT * FROM [Order Details] WHERE [OrderId]<10249;"
Set Rs = DB.OpenRecordset(RsSql, DB_OPEN_DYNASET)
Set xlApp = CreateObject("Excel.Application")
xlApp.workbooks.Add
Set Sheet = xlApp.activeworkbook.sheets(1)
j = 1
' Loop through the Microsoft Access field names and create
' the Microsoft Excel labels.
For i = 0 To Rs.Fields.Count - 1
CurrentValue = Rs.Fields(i).Name
Sheet.cells(j, i + 1).Value = CurrentValue
Next i
j = 2
' Loop through the Microsoft Access records and copy the records
' to the Microsoft Excel spreadsheet.
Do Until Rs.EOF
For i = 0 To Rs.Fields.Count - 1
CurrentField = Rs(i)
Sheet.cells(j, i + 1).Value = CurrentField
Next i
Rs.MoveNext
j = j + 1
Loop
' Print the Microsoft Excel spreadsheet.
Sheet.PrintOut
' Close workbook without saving.
xlApp.activeworkbook.saved = True
Set Sheet = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
is not already there:
Option Explicit
6. View the form in Form view, and then click the command button.
NOTE: The above code causes the Microsoft Excel spreadsheet to be printed. You do not see Microsoft Excel unless you had Microsoft Excel open before you chose the command button.
Additional query words:
Keywords : kbole IntpOlea kbfaq
Version : 2.0 7.0 97
Platform : WINDOWS
Hardware : x86
Issue type : kbinfoLast Reviewed: November 22, 1998