Access to Excel 1

[nberryman]

Access to Excel

I have a large list of Names and Departments in a Table.

I want to send the results of a department Query to a given area in an Excel spreadsheet. The sheet is called Summary and the fields are Name, Department and Sub Department

The number of names will vary from department to department and the start point in excel is Summary A3, A4 and A5 and down until all staff are entered

Thanks (again) guys, at least my VB is improving

Neil Berryman
IT Trainer
neil_berryman@btopenworld.com

 

[oharab]

Neil,
The easiest way to do this is to use Automation:
(All this code uses DAO, not worked with ADO much, yet.)

Dim objXL as Object
Dim xlWB as Object
Dim xlWS as Object
'some objects to refer to Excel
Dim db as DAO.Database
Dim rs as DAO.Recordset
Dim fld as DAO.Field
'Our db references.
Dim x as Integer
'Just a counter
set db=currentdb
set rs=db.openrecordset("qryDepartment&quot
'open our recordset
if rs.eof and rs.bof then exit sub
'if there are no records, then there's no point carrying on.
set objXL=createobject("Excel.Application&quot
set xlwb=objxl.workbooks.open("PathTo\Workbook.xls&quot
set xlws=xlwb.worksheets("Summary&quot
'set references to our excel worksheet

with xlws
.range("A3&quot.select
do until rs.eof
for x=0 to 2
.ActiveCell.Offset(0,x)=rs(x)
'copy each field into the cells
next x
.ActiveCell.Offset(1,0).select
'move down a row on spreadsheet
rs.movenext
'get next record
loop
end with

xlwb.save
xlwb.close
objxl.close

set xlws=nothing
set xlwb=nothing
set objxl=nothing

rs.close
set rs=nothing
set db=nothing
'tidy up time


The code assumes you do not need any parameters for the query (if it does and you can't work out how to make it work, let me know & I will change the code 4 u!) and that you want to save the file with the same name it started with.

If you want anything changing, let me know.

Cheers

ben ----------------------------------------
Ben O'Hara
Home: bpo@SickOfSpam.RobotParade.co.uk
Work: bo104@SickOfSpam.westyorkshire.pnn.police.uk
(in case you've not worked it out get rid of Sick Of Spam to mail me!)
Web:

http://www.RobotParade.co.uk

----------------------------------------

 

[nberryman]

Cheers Ben, I will give it a go.

Neil Berryman
IT Trainer
neil_berryman@btopenworld.com

 

[oharab]

FROM EMAIL:
>Thanks for that prompt answer but he code stops on
>Set rs = db.openrecordset("QrySelectDepartment&quot
>Runtime error 3061
>To few parameters, expected 1.
>The Query works when run manually
>Any ideas, by the way I added DAO 3.6 Object Library, is that right

The problem is your query needs parameters to run. When calling a parameter query as a recordset, you have to pass the parameters explictly, even if they are linked to an open form.

I've made the appropriate changes to the code, but you will need to modify them where necessary to match your needs:

Dim objXL as Object
Dim xlWB as Object
Dim xlWS as Object
'some objects to refer to Excel
Dim db as DAO.Database
Dim rs as DAO.Recordset
Dim fld as DAO.Field

Dim qd as DAO.QueryDef
Dim prm as DAO.Parameter
'Our db references.
Dim x as Integer
'Just a counter
set db=currentdb

set qd=db.querydefs("QrySelectDepartment&quot
'If your parameters are linked to fields on forms (eg Forms!frmDepartment!txtDept) then you can use:
'for each prm in qd.Parameters
' prm.value=eval(prm.name)
'next prm
'otherwise you have to pass them individually
qd.parameters("Enter Department Name&quot
'The parameter name is what you have typed in the query builder
set rs=qd.OpenRecordset
'open our recordset
if rs.eof and rs.bof then exit sub
'if there are no records, then there's no point carrying on.
set objXL=createobject("Excel.Application&quot
set xlwb=objxl.workbooks.open("PathTo\Workbook.xls&quot
set xlws=xlwb.worksheets("Summary&quot
'set references to our excel worksheet

with xlws
.range("A3&quot.select
do until rs.eof
for x=0 to 2
.ActiveCell.Offset(0,x)=rs(x)
'copy each field into the cells
next x
.ActiveCell.Offset(1,0).select
'move down a row on spreadsheet
rs.movenext
'get next record
loop
end with

xlwb.save
xlwb.close
objxl.close

set xlws=nothing
set xlwb=nothing
set objxl=nothing

rs.close
set rs=nothing
set db=nothing
'tidy up time

----------------------------------------
Ben O'Hara
Home: bpo@SickOfSpam.RobotParade.co.uk
Work: bo104@SickOfSpam.westyorkshire.pnn.police.uk
(in case you've not worked it out get rid of Sick Of Spam to mail me!)
Web:

http://www.RobotParade.co.uk

----------------------------------------

 

[nberryman]

Thanks again Ben

Neil Berryman
IT Trainer
neil_berryman@btopenworld.com

 

[nberryman]

Sorry

I've removed all the parameters for now, I will try the methods mentiond later but I now get the error

Object doesnt support this property or method and the following line is highlighted when I click debug

.ActiveCell.Offset(0, x) = rs(x)


Thanks again
Neil Berryman
IT Trainer
neil_berryman@btopenworld.com

 

[oharab]

Try changing teh line to :
objXL.ActiveCell.Offset(0, x) = rs(x)

I can never remember what Activecell is a member of!

B ----------------------------------------
Ben O'Hara
Home: bpo@SickOfSpam.RobotParade.co.uk
Work: bo104@SickOfSpam.westyorkshire.pnn.police.uk
(in case you've not worked it out get rid of Sick Of Spam to mail me!)
Web:

http://www.RobotParade.co.uk

----------------------------------------

 

[nberryman]

Trying that now

Neil Berryman
IT Trainer
neil_berryman@btopenworld.com

 

[nberryman]

That sorted it, many thanks again Ben

Neil Neil Berryman
IT Trainer
neil_berryman@btopenworld.com