Create Excel Workbooks Using Access

Hello,

Okay, I revisited this one and have gotten this far. The details are different but it is the same concept. Can anyone else offer assistance? I apologize for this not being indented (I don't know how to post that way.)

Sub CreateTheExcelWorkbooks()

Dim db As DAO.Database
Dim List1 As DAO.Recordset
Dim List2 As DAO.Recordset
Dim List3 As DAO.Recordset
Dim List4 As DAO.Recordset
Dim List5 As DAO.Recordset
Dim List6 As DAO.Recordset

Set db = CurrentDb()

Set List1 = CurrentDb.OpenRecordset("Select DISTINCT [super] from [Employee Snapshot]")
List1.MoveFirst
Do Until List1.EOF
'Need code to open Excel Workbook named "Supervisor.xls"
ActiveWorkbook.SaveAs "C:\Temp\" & List1.Fields("EmpName") & ".xls" 'If last character is "." remove
'Need code to copy "sheet1" and name = Left(List1.fields ("EmpName"), InStr(1, List1.fields ("EmpName"), ",", 1) - 1)
'Need code to select all records in List1 and paste into this new sheet starting at row4
Set List2 = CurrentDb.OpenRecordset("SELECT * FROM [Employee Snapshot] WHERE [super] =" & List1![EmpNo])
List2.MoveFirst
Do Until List2.EOF
'Need code to copy "sheet1" and name = Left(List2.fields ("EmpName"), InStr(1, List2.fields ("EmpName"), ",", 1) - 1)
'if worksheet name already exists, name = Left(List2.fields ("EmpName"), InStr(1, List2.fields ("EmpName"), ",", 1) - 1) & "(1)" (increment this as needed)
'Need code to select all records in List2 and paste into this new sheet starting at row4
Set List3 = CurrentDb.OpenRecordset("SELECT * FROM [Employee Snapshot] WHERE [super] =" & List2![EmpNo])
List3.MoveFirst
Do Until List3.EOF
'Need code to copy "sheet1" and name = Left(List3.fields ("EmpName"), InStr(1, List3.fields ("EmpName"), ",", 1) - 1)
'if worksheet name already exists, name = Left(List3.fields ("EmpName"), InStr(1, List3.fields ("EmpName"), ",", 1) - 1) & "(1)" (increment this as needed)
'Need code to select all records in List3 and paste into this new sheet starting at row4
Set List4 = CurrentDb.OpenRecordset("SELECT * FROM [Employee Snapshot] WHERE [super] =" & List3![EmpNo])
List4.MoveFirst
Do Until List4.EOF
'Need code to copy "sheet1" and name = Left(List4.fields ("EmpName"), InStr(1, List4.fields ("EmpName"), ",", 1) - 1)
'if worksheet name already exists, name = Left(List4.fields ("EmpName"), InStr(1, List4.fields ("EmpName"), ",", 1) - 1) & "(1)" (increment this as needed)
'Need code to select all records in List4 and paste into this new sheet starting at row4
Set List5 = CurrentDb.OpenRecordset("SELECT * FROM [Employee Snapshot] WHERE [super] =" & List4![EmpNo])
List5.MoveFirst
Do Until List5.EOF
'Need code to copy "sheet1" and name = Left(List5.fields ("EmpName"), InStr(1, List5.fields ("EmpName"), ",", 1) - 1)
'if worksheet name already exists, name = Left(List5.fields ("EmpName"), InStr(1, List5.fields ("EmpName"), ",", 1) - 1) & "(1)" (increment this as needed)
'Need code to select all records in List5 and paste into this new sheet starting at row4
Set List6 = CurrentDb.OpenRecordset("SELECT * FROM [Employee Snapshot] WHERE [super] =" & List5![EmpNo])
'Need code to copy "sheet1" and name = Left(List6.fields ("EmpName"), InStr(1, List6.fields ("EmpName"), ",", 1) - 1)
'if worksheet name already exists, name = Left(List6.fields ("EmpName"), InStr(1, List6.fields ("EmpName"), ",", 1) - 1) & "(1)" (increment this as needed)
'Need code to select all records in List6 and paste into this new sheet starting at row4
List5.MoveNext
Loop
List4.MoveNext
Loop
List3.MoveNext
Loop
List2.MoveNext
Loop
ActiveWorkbook.Sheets(1).Delete
'need code to sort worksheets in ascending order
ActiveWorkbook.Close
'Activate "Supervisor.xls"
List1.MoveNext
Loop

List1.Close
List2.Close
List3.Close
List4.Close
List5.Close
List6.Close

Set List1 = Nothing
Set List2 = Nothing
Set List3 = Nothing
Set List4 = Nothing
Set List5 = Nothing
Set List6 = Nothing

Set db = Nothing

End Sub

Hi,

First of all, to post formatted code use the BB code tags. Click the Code button which appears above the texbox when you're composing/editing a message, then paste your code and click the Code button again to close the tag.

There's a lot of stuff you're asking for here so I'll take it a few steps at a time...



If you're running this code in Access then you can't just refer to Excel objects (e.g. ActiveWorkbook) without qualifying them. Access does not know what Activeworkbook is. This code will get an instance of Excel.


And this is how the first part of your code might look (to open the Supervisor.xls file):-


To copy a sheet in Excel and rename it use something like this:


To copy a recordset into an Excel worksheet use the CopyFromRecordset method e.g.

sht.Range("A4").CopyFromRecordset List2

This code will paste the contents of the List2 recordset into the 'sht' worksheet starting at range A4.

That should get you going. Let me know how you get on fixing up this lot.

Dan,

Thank you very much for looking at this. Here is where I am so far. And, thanks to your instructions, it should look much cleaner The code works fine until list3 then it does not pull records using fields.super from list2.

Hello again,

You should get rid of the On Error Resume Next just above the Set List3 bit. You should then be able to see if there is an error in your code. With the error trapping there you've got no hope of working out what's going wrong.

Let me know how you get on,
Dan

Hi Dan,

Sometimes there will be no records that exist for the "super" in list2. Is there a better way to exit the list3 loop and fall back into the list2 loop? That is why I put the "on error resume next" there.

Foxhound

You can test for an empty recordset by testing its BOF and EOF properties and seeing if they're both true. If a recordset is at the beginning and the end then there must be no records. Here's an example:-


You should be able to incorporate this into your code and avoid the error trapping, which is certainly a good thing while you're developing this as you'll be able to pinpoint potential errors in your code.

Okay, I am having a difficult time with list3. I can't make it past selecting the records to test for "If List3.BOF And List3.EOF Then" because I keep getting the error, "no current records." It is true that there are no records in [Employee Snapshot] with some of the [super]'s but I don't think it is even recognizing the [super] field from list2.

So with the posted code, workbooks are being created and saved correctly for all records belonging to each [super] from list2 but it is not pulling records from [Employee Snapshot] in the later loops because they aren't being recognized.

Any suggestion