HandsOn Copying Records to an Excel Spreadsheet

1. Switch to the Visual Basic Editor window and insert a new module.

2. Choose Tools | References in the Visual Basic Editor window, scroll down to locate the Microsoft Excel Object Library, click the check box next to it, then click OK to exit.

3. In the Code window, enter the CopyToExcel procedure as shown below.

Option Compare Database Option Explicit

' be sure to select Microsoft Excel Object Library ' in the References dialog box

Public myExcel As Excel.Application

Sub CopyToExcel()

Dim conn As ADODB.Connection Dim rst As ADODB.Recordset Dim wbk As Excel.Workbook Dim wks As Excel.Worksheet Dim StartRange As Excel.Range Dim strConn As String Dim i As Integer Dim f As Variant

On Error GoTo ErrorHandler strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & CurrentProject.Path & _ "\Northwind.mdb"

Set conn = New ADODB.Connection

' open the recordset on the Employees table Set rst = New ADODB.Recordset With rst

Creating and Manipulating Databases with ADO

.Open "Employees", strConn, _ adOpenKeyset, adLockOptimistic End With

' declare a module-level object ' variable myExcel as Excel.Application ' at the top of the module Set myExcel = New Excel.Application

' create a new Excel workbook Set wbk = myExcel.Workbooks.Add

' set the reference to the ActiveSheet Set wks = wbk.ActiveSheet

' make the Excel application window visible myExcel.Visible = True i = 1

' Create the column headings in cells With rst

For Each f In .Fields With wks

.Cells(1, i).Value = f.Name i = i + 1 End With Next End With

' specify the cell range that will receive the data (A2) Set StartRange = wks.Cells(2, 1)

' copy the records from the recordset ' and place in cell A2 StartRange.CopyFromrecordset rst rst.Close

Set rst = Nothing

' autofit the columns to make the data fit ' wks.Columns("A:Z").AutoFit wks.Columns.AutoFit

' close the workbook and save the file wbk.Close SaveChanges:=True, _ FileName:="C:\ExcelDump.xls"

' quit the Excel application myExcel.Quit

Set conn = Nothing

Exit Sub

ErrorHandler:

MsgBox Err.Description, vbCritical, _ "Automation Error"

Part II

Set myExcel = Nothing Exit Sub End Sub

•' i Exch IDump.xls

HEE3I

A

8

C

D

E

F

G H 1

1

LmployeeC

LastName

FirstName Title

li:ieOfCaurr^5y

BirthDate

HireDate address

I City

:SD7- lOtiiAve.E.D

2

1

Davolio

Nancy

Sales Rep

Ms

12W968

»1/1982 Apt. 2A

Seattle

3

2

Fuller

Andrew

Vice President, Sales

Dr.

1ST 953

9/14/1332 33Q W. Capital Way

Tacorna

4

3

Levelling

Janet

Sales Rep

Ms

SCOT

4/1 n 892 722 Moss BaySlvd

Kirkiand

5

4

Peacock

Margaret

Sales Rep

Mrs

9i19fi958

5/3/1893 6111 Old Redmond Rd.

Redmond

6

5

Buchanan

Steven

Sales Manager

Mr

2M/1955

10/17/1333 14 Garrett Hill

London

Country House □

t

6

Suyama

Michael

Sales Rep_

Mr.

7/2/1363

10/17/1333 Miner R±

London

S

7

King

Robert

Sales Rep

Mr.

6/29/196U

Edgeham Hollows 1/2/1894 Winchester Way

London

9

a

Callahan

Laura

Inside Sales Coordinator

Ms

1/8/1 953

3/5/1334 473B- MthAve NE

Seattle

-o

8

Dodsworth

Anne

Sales Rep

Ms.

7/2/I9B3

11/15/1894 7 Houndstooth Rd.

London

-

» H \slweti / 3-rar;: / 3ieet3 /

M

H

M

Figure 14-1: This Excel spreadsheet is created from Access data by running the procedure in Hands-On 14-5.

Figure 14-1: This Excel spreadsheet is created from Access data by running the procedure in Hands-On 14-5.

0 0

Post a comment