Export Access Query To 1 Workbook, but on different worksheets 1

[Cran56]

Hi - I want to export an access query to an excel workbook, but the kicker is the information needs to be seperated onto different worksheets in the workbook.

Example of what I'm working with:
Query: "select event_id, event, date, time, building from calendar where event is not null"

I want to put the specific event data on a worksheet that is specific to the particular building. So that means I could have lots of worksheets in the excel workbook, with each worksheet specific to the particular building.

Thanks for any help! If anyone has any code that would be VERY helpful as well. Thanks!

 

[Chance1234]

HEre is a bit of code, that loops through one recordset and sets up a worksheet for each record there, and then populates each sheet with data relating to the first recordset from a second set.

So set up one recordset with your building names

The loop Through

Do until rec1.eof = true

add xlsheet

xlsheet.name = rec1![building name]

then use your building name to pull data from the second recordset

set rec2 = "SELECT * FROM rec WHERE building name " = rec1![Building name]

With xlsheet
.cells1 = 333

loop

Loop

Dim dbmain As DAO.Database
Dim rec_members As DAO.Recordset
Dim rec_report As DAO.Recordset
Dim XL_app As Excel.Application
Dim XL_book As Workbooks
Dim XL_sheet As Worksheet
Dim str_mem_SQL As String
Dim str_rep_SQL As String
Dim int_member As Double
Dim intR, IntC As Integer

Set dbmain = CurrentDb()

'--------- Set up workbook ---------------------
Set XL_app = New Excel.Application
Set XL_book = XL_app.Workbooks
XL_book.Add

'------------

str_mem_SQL = "SELECT * from your data "


Set rec_members = dbmain.OpenRecordset(str_mem_SQL)

rec_members.MoveFirst

Do Until rec_members.EOF = True
intR = 8
IntC = 2

    int_member = rec_members![member_no]
    
    str_rep_SQL = "SELECT * from your data number 2 where your data 1 = your data two  "
    Set rec_report = dbmain.OpenRecordset(str_rep_SQL)
    rec_report.MoveFirst
    Set XL_sheet = XL_book(1).Worksheets.Add
   
   With XL_sheet
        .Name = int_member
        .Range("B2").Value = rec_report![Name]
        .Range("B3").Value = rec_report![member_no]
        .Range("b4").Value = "Capital "
        .Range("B5").Value = "Y April"
        
        .Range("B7").Value = "Date"
        .Range("C7").Value = "Description"
        .Range("D7").Value = "Asset Code"
        .Range("E7").Value = "Nominee"
        .Range("F7").Value = "Bulk or Individual"
        .Range("G7").Value = "Event Code"
        .Range("H7").Value = "Event Description"
        .Range("I7").Value = "Quantity"
        .Range("J7").Value = "Cost Proceeds"
        .Range("K7").Value = "ident"
        .Range("L7").Value = "badger"
   End With

   Do Until rec_report.EOF = True
        With XL_sheet
            .Cells(intR, IntC).Value = Format(rec_report![asset_date], "DD/MM/yyyy")
            .Cells(intR, IntC + 1).Value = rec_report![asset_description]
            .Cells(intR, IntC + 2).Value = rec_report![asset_code]
            .Cells(intR, IntC + 3).Value = rec_report![nominee]
            .Cells(intR, IntC + 4).Value = rec_report![bulk_or_individual]
            .Cells(intR, IntC + 5).Value = rec_report![event_code]
            .Cells(intR, IntC + 6).Value = rec_report![event_description]
            .Cells(intR, IntC + 7).Value = rec_report![quantity]
            .Cells(intR, IntC + 8).Value = CCur(rec_report![cost_proceeds] / 100)
            .Cells(intR, IntC + 9).Value = rec_report![ident]
            .Cells(intR, IntC + 10).Value = rec_report![badger]
        
        End With
        intR = intR + 1
    rec_report.MoveNext
   Loop
   
      With XL_sheet
            .Columns("K:L").EntireColumn.Hidden = True
            .Range("B7:J7").Font.Bold = True
            .Range("B7:J7").Interior.ColorIndex = 15
            
            With .Range("B2:B5")
                .HorizontalAlignment = xlLeft
                .Font.Name = "Arial"
                .Font.Size = 11
                .Font.Bold = True
            End With
            
            With .PageSetup
                .PrintHeadings = False
                .PrintGridlines = False
                .PrintComments = xlPrintNoComments
                .PrintQuality = 600
                .CenterHorizontally = False
                .CenterVertically = False
                .Orientation = xlLandscape
                .Draft = False
                .PaperSize = xlPaperA4
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
                .BlackAndWhite = False
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            
            .Columns("B:B").ColumnWidth = 9.43
            .Columns("C:C").ColumnWidth = 44.14
            .Columns("D:D").ColumnWidth = 10.29
            .Columns("E:E").ColumnWidth = 16.29
            .Columns("F:F").ColumnWidth = 16.57
            .Columns("G:G").ColumnWidth = 10.57
            .Columns("H:H").ColumnWidth = 16.44
            .Columns("I:I").ColumnWidth = 11.29
            .Columns("J:J").ColumnWidth = 13.29
            
      End With
      
    rec_members.MoveNext

Loop
XL_app.DisplayAlerts = False
XL_book(1).Worksheets("SHEET1").Delete
XL_book(1).Worksheets("SHEET2").Delete
XL_book(1).Worksheets("SHEET3").Delete

Chance,

Filmmaker, gentlemen and read my blog at

http://www.20six.co.uk/Chance1234