Solved Export several queries with CopyFromRecordset to Excel

C

Cris VS

Member
Local time
Today, 16:41
Joined
Sep 16, 2021
Messages
75
Hello all,

I was wondering if someone could help me with this one: I am exporting some queries to Excel using CopyFromRecordset and as I need them to be one under the other, I would like to know if there is a way to keep count of the row number, maybe with a loop or something similar. I cannot export them as one sole query because I need to add notes and other things in between, so I could really use some kind of row count to make it look clean and tidy.

Thanks

PS.: I don't know how many records there will be in advance
 
A recordset has a recordcount property. Use MoveLast to get the actual recordcount.
 
Gasman said:
A recordset has a recordcount property. Use MoveLast to get the actual recordcount.
Click to expand...
Makes sense, but I am not sure how to relate the row number to the record count...
 
You can use the End.Row of the range object to get your last row directly in Excel:
Code: 
 'add the totals
        'we need to add a total now
        lastRow = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
        oWS.Range("A" & lastRow + 1).Activate
        oWS.Range("A" & lastRow + 1) = "TOTAL:"
        oWS.Range("A" & lastRow + 1).Font.Bold = True
        oWS.Range("D" & lastRow + 1) = .WorksheetFunction.Sum(oWS.Range("D2:D" & lastRow))
        oWS.Range("D" & lastRow + 1).Font.Bold = True
 
bastanu said:
You can use the End.Row of the range object to get your last row directly in Excel:
Code: 
 'add the totals
        'we need to add a total now
        lastRow = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
        oWS.Range("A" & lastRow + 1).Activate
        oWS.Range("A" & lastRow + 1) = "TOTAL:"
        oWS.Range("A" & lastRow + 1).Font.Bold = True
        oWS.Range("D" & lastRow + 1) = .WorksheetFunction.Sum(oWS.Range("D2:D" & lastRow))
        oWS.Range("D" & lastRow + 1).Font.Bold = True
Click to expand...
If I use this code inside a With xlSheet loop, I should substitute oWS with xlSheet in the first line and then just write .Range... Right?
 
Cris VS said:
Makes sense, but I am not sure how to relate the row number to the record count...
Click to expand...
Well you can do it in Excel as shown above, or do it in Access with some simple math?
You start at row 1 and add 310 rows. Presumably you would then start on row 311, and so on?
If you add notes in between then keep track of how many rows of notes you make. However if you are going to do that, then may as well do it all in Excel?
 
Yes, just adapt it to match your naming convention. Here is my entire (adapted for posting) procedure:

Cheers,
Code: 
Dim oApp As Excel.Application
Dim oWT As Excel.Workbook
Dim oWS As Excel.Worksheet

Dim lastRow As Long
Dim lStartOfDataList As Long
Dim lEndOfDatList As Long
DIm db as DAO.Database,rs as DAO.Recordset,prm as Parameter
 
Set db = CurrentDb
Set qdf = db.QueryDefs("qryYOUR_QUERY")
  
For Each prm In qdf.Parameters
    prm.Value = Eval(prm.Name)
Next prm
  
Set rs = qdf.OpenRecordset()

Application.Echo False
Set oApp = GetObject("Excel.Application")
          If Err.Number <> 0 Then Set oApp = CreateObject("Excel.Application")
    With oApp
        .Visible = True
        .Workbooks.Close
        On Error GoTo 0
        .Workbooks.Add
        .Workbooks(1).Activate

        Set oWT = .ActiveWorkbook
        Set oWS = oWT.ActiveSheet

        .ScreenUpdating = False
        .DisplayAlerts = False
        'set orientation to landscape
        oWS.PageSetup.Orientation = xlLandscape
        'lets do the header
        oWS.PageSetup.CenterHeader = "&""Arial,Bold""&10" & "Excel Export Sample"
        'now the footer
'        oWS.PageSetup.CenterFooter = " = Page " & "[Page]" & " of " & "[Pages]"
'         oWS.PageSetup.RightFooter = " = " & "[Date]" & ""
        
        oWS.PageSetup.CenterFooter = "Page &P of &N"
        oWS.PageSetup.RightFooter = "Printed &D &T"
        oWS.PageSetup.LeftFooter = "FBA Excel Export Sample"
        
        
        oWS.PageSetup.LeftMargin = oApp.InchesToPoints(0.75)
        oWS.PageSetup.RightMargin = oApp.InchesToPoints(0.75)
        oWS.PageSetup.TopMargin = oApp.InchesToPoints(1)
        oWS.PageSetup.BottomMargin = oApp.InchesToPoints(1)
        oWS.PageSetup.PaperSize = xlPaperLegal
        'force one fit one page wide
        oWS.PageSetup.Zoom = False
        oWS.PageSetup.FitToPagesWide = 1
        oWS.PageSetup.FitToPagesTall = False
        
        oWS.PageSetup.PrintTitleRows = oWS.Range("A1", oWS.Range("A1").End(xlUp)).EntireRow.Address
        'use CopyFromRecordset
        oWS.Range("A1")..CopyFromRecordset rs 'your recordset set at the start of procedure
        'add the totals
        'we need to add a total now
        lastRow = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
        oWS.Range("A" & lastRow + 1).Activate
        oWS.Range("A" & lastRow + 1) = "TOTAL:"
        oWS.Range("A" & lastRow + 1).Font.Bold = True
        oWS.Range("D" & lastRow + 1) = .WorksheetFunction.Sum(oWS.Range("D2:D" & lastRow)) 'your column to be summed
        oWS.Range("D" & lastRow + 1).Font.Bold = True
          
        
        
        oWS.Range("E" & lastRow + 1) = .WorksheetFunction.Sum(oWS.Range("E2:E" & lastRow))  'your column to be summed
        oWS.Range("E" & lastRow + 1).Font.Bold = True
        
        oWS.Range("D2:E" & lastRow + 1).NumberFormat = "$#,##0.00"
        
        oWS.Range("A" & lastRow & ":K" & lastRow).Borders(xlEdgeBottom).LineStyle = xlContinuous
        oWS.Range("A" & lastRow & ":K" & lastRow).Borders(xlEdgeBottom).Weight = xlThick
        oWS.Range("A" & lastRow & ":K" & lastRow).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
         'now to autofit columns
        lastRow = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
        lEndOfDatList = lastRow
        oWS.Range("A1:J" & lastRow).Select
        .Selection.Font.Size = 10
        .Selection.WrapText = False
        oWS.Range("A1:K" & lastRow).Columns.AutoFit
        oWS.Range("A1").Select
        
        oWS.Range("A" & lastRow + 2 & ":E" & lastRow + 2).Merge
        oWS.Range("A" & lastRow + 2 & ":E" & lastRow + 2).VerticalAlignment = xlTop
        oWS.Range("A" & lastRow + 2 & ":E" & lastRow + 2).HorizontalAlignment = xlRight
        oWS.Range("A" & lastRow + 2) = "Approved for posting:  ____________________________________________________"
        oWS.Range("A" & lastRow + 2).Font.Name = "Calibri"
        oWS.Range("A" & lastRow + 2).Font.Size = 10
        oWS.Range("A" & lastRow + 2).Font.Bold = True
        
        oWS.Range("A" & lastRow + 3 & ":E" & lastRow + 3).Merge
        oWS.Range("A" & lastRow + 3 & ":E" & lastRow + 3).VerticalAlignment = xlTop
        oWS.Range("A" & lastRow + 3 & ":E" & lastRow + 3).HorizontalAlignment = xlRight
        oWS.Range("A" & lastRow + 3) = "Date:  ____________________________________________________"
        oWS.Range("A" & lastRow + 3).Font.Name = "Calibri"
        oWS.Range("A" & lastRow + 3).Font.Size = 10
        oWS.Range("A" & lastRow + 3).Font.Bold = True
        
        oWT.Worksheets("Sheet1").Name = "FBA Excel Export Sample"
          
        
        .ScreenUpdating = True
        .DisplayAlerts = True
     End With


Application.Echo True
Set rs=Nothing
Set db=Nothing
oApp.Visible = True
AppActivate "Microsoft Excel"
Set oApp = Nothing
 
Last edited:
Gasman said:
Well you can do it in Excel as shown above, or do it in Access with some simple math?
You start at row 1 and add 310 rows. Presumably you would then start on row 311, and so on?
If you add notes in between then keep track of how many rows of notes you make. However if you are going to do that, then may as well do it all in Excel?
Click to expand...
Yes, that's what I would like to do, but I want it to run when clicking on a button in Access, so that the user gets the Excel application done.
 
bastanu said:
Yes, just adapt it to match your naming convention. Here is my entire (adapted for posting) procedure:

Cheers,
Code: 
Dim oApp As Excel.Application
Dim oWT As Excel.Workbook
Dim oWS As Excel.Worksheet

Dim lastRow As Long
Dim lStartOfDataList As Long
Dim lEndOfDatList As Long
DIm db as DAO.Database,rs as DAO.Recordset,prm as Parameter

Set db = CurrentDb
Set qdf = db.QueryDefs("qryYOUR_QUERY")
 
For Each prm In qdf.Parameters
    prm.Value = Eval(prm.Name)
Next prm
 
Set rs = qdf.OpenRecordset()

Application.Echo False
Set oApp = GetObject("Excel.Application")
          If Err.Number <> 0 Then Set oApp = CreateObject("Excel.Application")
    With oApp
        .Visible = True
        .Workbooks.Close
        On Error GoTo 0
        .Workbooks.Add
        .Workbooks(1).Activate

        Set oWT = .ActiveWorkbook
        Set oWS = oWT.ActiveSheet

        .ScreenUpdating = False
        .DisplayAlerts = False
        'set orientation to landscape
        oWS.PageSetup.Orientation = xlLandscape
        'lets do the header
        oWS.PageSetup.CenterHeader = "&""Arial,Bold""&10" & "Excel Export Sample"
        'now the footer
'        oWS.PageSetup.CenterFooter = " = Page " & "[Page]" & " of " & "[Pages]"
'         oWS.PageSetup.RightFooter = " = " & "[Date]" & ""
       
        oWS.PageSetup.CenterFooter = "Page &P of &N"
        oWS.PageSetup.RightFooter = "Printed &D &T"
        oWS.PageSetup.LeftFooter = "FBA Excel Export Sample"
       
       
        oWS.PageSetup.LeftMargin = oApp.InchesToPoints(0.75)
        oWS.PageSetup.RightMargin = oApp.InchesToPoints(0.75)
        oWS.PageSetup.TopMargin = oApp.InchesToPoints(1)
        oWS.PageSetup.BottomMargin = oApp.InchesToPoints(1)
        oWS.PageSetup.PaperSize = xlPaperLegal
        'force one fit one page wide
        oWS.PageSetup.Zoom = False
        oWS.PageSetup.FitToPagesWide = 1
        oWS.PageSetup.FitToPagesTall = False
       
        oWS.PageSetup.PrintTitleRows = oWS.Range("A1", oWS.Range("A1").End(xlUp)).EntireRow.Address
        'use CopyFromRecordset
        oWS.Range("A1")..CopyFromRecordset rs 'your recordset set at the start of procedure
        'add the totals
        'we need to add a total now
        lastRow = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
        oWS.Range("A" & lastRow + 1).Activate
        oWS.Range("A" & lastRow + 1) = "TOTAL:"
        oWS.Range("A" & lastRow + 1).Font.Bold = True
        oWS.Range("D" & lastRow + 1) = .WorksheetFunction.Sum(oWS.Range("D2:D" & lastRow)) 'your column to be summed
        oWS.Range("D" & lastRow + 1).Font.Bold = True
         
       
       
        oWS.Range("E" & lastRow + 1) = .WorksheetFunction.Sum(oWS.Range("E2:E" & lastRow))  'your column to be summed
        oWS.Range("E" & lastRow + 1).Font.Bold = True
       
        oWS.Range("D2:E" & lastRow + 1).NumberFormat = "$#,##0.00"
       
        oWS.Range("A" & lastRow & ":K" & lastRow).Borders(xlEdgeBottom).LineStyle = xlContinuous
        oWS.Range("A" & lastRow & ":K" & lastRow).Borders(xlEdgeBottom).Weight = xlThick
        oWS.Range("A" & lastRow & ":K" & lastRow).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
         'now to autofit columns
        lastRow = oWS.Range("A" & oWS.Rows.Count).End(xlUp).Row
        lEndOfDatList = lastRow
        oWS.Range("A1:J" & lastRow).Select
        .Selection.Font.Size = 10
        .Selection.WrapText = False
        oWS.Range("A1:K" & lastRow).Columns.AutoFit
        oWS.Range("A1").Select
       
        oWS.Range("A" & lastRow + 2 & ":E" & lastRow + 2).Merge
        oWS.Range("A" & lastRow + 2 & ":E" & lastRow + 2).VerticalAlignment = xlTop
        oWS.Range("A" & lastRow + 2 & ":E" & lastRow + 2).HorizontalAlignment = xlRight
        oWS.Range("A" & lastRow + 2) = "Approved for posting:  ____________________________________________________"
        oWS.Range("A" & lastRow + 2).Font.Name = "Calibri"
        oWS.Range("A" & lastRow + 2).Font.Size = 10
        oWS.Range("A" & lastRow + 2).Font.Bold = True
       
        oWS.Range("A" & lastRow + 3 & ":E" & lastRow + 3).Merge
        oWS.Range("A" & lastRow + 3 & ":E" & lastRow + 3).VerticalAlignment = xlTop
        oWS.Range("A" & lastRow + 3 & ":E" & lastRow + 3).HorizontalAlignment = xlRight
        oWS.Range("A" & lastRow + 3) = "Date:  ____________________________________________________"
        oWS.Range("A" & lastRow + 3).Font.Name = "Calibri"
        oWS.Range("A" & lastRow + 3).Font.Size = 10
        oWS.Range("A" & lastRow + 3).Font.Bold = True
       
        oWT.Worksheets("Sheet1").Name = "FBA Excel Export Sample"
         
       
        .ScreenUpdating = True
        .DisplayAlerts = True
     End With


Application.Echo True
Set rs=Nothing
Set db=Nothing
oApp.Visible = True
AppActivate "Microsoft Excel"
Set oApp = Nothing
Click to expand...
I will try this also, thank you!
 
Thank you all for the help, it was just what I needed to solve my problem
 
You must log in or register to reply here.

Similar threads

B
  • Question Question
export and transpose problem
Replies
6
Views
993
Gasman
Gasman
N
Solved Export data from Passthrough Query to CSV
Replies
18
Views
1,453
Gasman
Gasman
S
Export Report to PDF with Index to Records
Replies
7
Views
271
Trevor G
Trevor G
C
Error 3828 when exporting queries to Excel
2
Replies
34
Views
1,609
ChrisMore
C
A
Solved Exporting Table to Excel by Category
Replies
9
Views
1,218
abrody
A

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom