Solved Export several queries with CopyFromRecordset to Excel (1 Viewer)

C

Cris VS

Member
Local time
Today, 20:34
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
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 19:34
Joined
Sep 21, 2011
Messages
14,237
A recordset has a recordcount property. Use MoveLast to get the actual recordcount.
 
C

Cris VS

Member
Local time
Today, 20:34
Joined
Sep 16, 2021
Messages
75
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...
 
bastanu

bastanu

AWF VIP
Local time
Today, 11:34
Joined
Apr 13, 2010
Messages
1,402
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
 
C

Cris VS

Member
Local time
Today, 20:34
Joined
Sep 16, 2021
Messages
75
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?
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 19:34
Joined
Sep 21, 2011
Messages
14,237
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?
 
bastanu

bastanu

AWF VIP
Local time
Today, 11:34
Joined
Apr 13, 2010
Messages
1,402
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:
C

Cris VS

Member
Local time
Today, 20:34
Joined
Sep 16, 2021
Messages
75
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.
 
C

Cris VS

Member
Local time
Today, 20:34
Joined
Sep 16, 2021
Messages
75
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!
 
C

Cris VS

Member
Local time
Today, 20:34
Joined
Sep 16, 2021
Messages
75
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

oxicottin
Solved Export to Excel error '1004' With time format
Replies
9
Views
207
ebs17
E
S
Solved Export from Ms Access form in to Excel
Replies
5
Views
269
skdn71
S
L
Data Change in CSV file after TransferText data export.
2 3
Replies
53
Views
1,090
DickyP
D
B
Export main form record along with subform records to Excel?
Replies
8
Views
339
Gasman
Gasman
1
Help with creating a button to export PDF file
2
Replies
33
Views
1,689
Gasman
Gasman

Users who are viewing this thread

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