Access VBA Code To Append 10 Queries Into 1 Excel Tab

[VBA123novice]

I have very little experience with Access VBA so I'm hoping you can help me. I have an access 2010 database setup as follows:

4 tables linked to other access databases
A union qry (qry_all) linking the above 4 tables
A select query based off above union query (qry_all_calcs) with calculated fields.

The data will be updated/added weekly until the end of the year. there are currently about 900,000 records. I want to link the last query to an excel file (for a report) but it's too much data. However, I have 10 select queries with a criteria of office location (eg qry_atlanta, qry_dallas, qry_new york) that run off the qry_all_calcs - those do succesfully run and link to excel.

as a work around i'd like to create code that will append the data from the 10 location queries to 1 tab in an excel workbook. when the vba code is run it should delete all data in the tab first.

I'm just beginning to learn vba but I'm not a programmer so I'd really appreciate as much detail with code as possible.

[ADezii]

1. You ask for much Detail, but you provide little.
2. How many Fields are there in the Location Queries?
3. Are these Fiels static for each Query?
4. Post the SQL for a Location Query.
5. All Data on Worksheet to be Deleted prior to move?
6. Is this essentially an Append of Data from 10 Queries to an single Excel Spreadsheet?
7. etc...

[bytes access nubie]

1. You ask for much Detail, but you provide little.
2. How many Fields are there in the Location Queries?
3. Are these Fiels static for each Query?
4. Post the SQL for a Location Query.
5. All Data on Worksheet to be Deleted prior to move?
6. Is this essentially an Append of Data from 10 Queries to an single Excel Spreadsheet?
7. etc...

1. About 75 fields in the location queries
2. Yes the fields are static. Each query is based off of the same data source (qry_all_calcs) with 1 criteria - location
3. Yes, all data on worksheet to be deleted prior to copying the data from the 10 queries (mentioned in original post)
4. This is an append of each query into one worksheet (mentioned in original post).

It's alot to display the sql of 75 fields. The 10 select queries originally mentioned are literally just a select query with 1 criteria - the location. Thank you.

[ADezii]

Off the top of my head, the only way of accomplishing this would be via a combination of Recordset Programming/Excel Automation Code. With limited VBA experience on your part, this may be a little challenging. If you want me to proceed, I'll see what I can come up with...

[ADezii]

I have arrived at what I feel is a relatively simple, efficient response to your question. The Logic works great on small Recordsets but on 10 large Recordsets is a totally different story. I've tested my Version and it works well. Everything that I arrived at will be posted below:

1. Create a Default Excel Workbook and Save it in the 'same' Folder as your Database. Name it Locations.xls.
2. Preface all 10 of your Location Queries with 'qryLoc' as in: qryLocRegionA, qryLocRegionB, etc.
3. Set a Reference to the Microsoft Excel XX.X Object Library.
4. Execute the following Code:
   

   Dim appExcel As Excel.Application
   Dim rst As DAO.Recordset
   Dim MyDB As DAO.Database
   Dim qdf  As QueryDef
   Dim intNumOfLocQueries As Integer
   Dim intNextRow As Integer
   
   'Make sure to Set a Reference to the Microsoft Excel XX.X Object Library
   Set MyDB = CurrentDb
   Set appExcel = CreateObject("Excel.Application")
       
   With appExcel
     .Visible = True
     .UserControl = True
       With .Workbooks.Open(CurrentProject.Path & "\Locations.xls")
        .Worksheets("Sheet1").Activate
           For Each qdf In CurrentDb.QueryDefs
             If Left$(qdf.Name, 6) = "qryLoc" Then
               intNumOfLocQueries = intNumOfLocQueries + 1
                 If intNumOfLocQueries = 1 Then
                   Set rst = MyDB.OpenRecordset(qdf.Name)
                     .Worksheets("Sheet1").Range("A1").CopyFromRecordset rst
                       intNextRow = .ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                 Else
                   Set rst = MyDB.OpenRecordset(qdf.Name)
                     .Worksheets("Sheet1").Range("A" & CStr(intNextRow)).CopyFromRecordset rst
                       intNextRow = .ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                 End If
             End If
           Next qdf
       End With
   End With
       
   rst.Close
       
   Set rst = Nothing
   Set appExcel = Nothing
   Set qdf = Nothing
   Set qdf = Nothing

5. This Code will:
   1. Make the required Variable Declarations.
   2. Set References to the Excel Application Object as well as the Current Database.
   3. Set a couple Properties of the Excel Application.
   4. Open the Workbook you previously created (CurrentProject .Path & "\Locations.xls ")
   5. Activate Sheet1.
   6. Loop thru all Querys in the Current Database and if they are prefaced with qryLoc, create a Recordset based on that specific Query.
   7. If it is the 1st Location Query, Copy the Recordset starting at Sheet1!A1.
   8. If it is not the 1st Query, then repeat the process but Copy the Recordset starting at Column A!Last Row With Data + 1.
   9. Close the Recordset and release Memory that was assigned to Object Variables.
6. Good Luck - any questions, feel free to ask.

[bytes access nubie]

Thank you SO much!! I am planning to work on this tomorrow afternoon. Thank you for all of the detail!!

[ADezii]

You are quite welcome, let me know how you make out.

[bytes access nubie]

Hi adezii. I started looking at your code/notes this afternoon & began setting things up. I got pulled away to something else though. I plan to pick this up tomorrow though. Thank you again!

[bytes access nubie]

hi adezii. The code did run for the 1st 2 queries, thank you!! But I think you are right - it may be too much for all of the data. The code opened the excel workbook & copied in the data from the first 2 queries (88,000 records). however, the code then hangs & switching back to VB the message displayed: Run Time Error 6 Overflow. There are about 66,000 records in the 3rd query. Pressing Debug highlights the below line of code.

intNextRow = .ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1

Here is other code that works for 1 hard coded query. I don't know if it would help to combine the code somehow with your code. I truly appreciate your help because at this point my knowledge is so limited...

Sub ExportData()
Dim wbDest As Excel.workbook
Dim wsDest As Excel.worksheet
Dim rsSrc As DAO.Recordset
Dim i As Integer

'open your workbook using a set wbdest = statement

Set wbDest = Excel.Application.Workbooks.Open("D:\Temp\test2.xlsx", False, False)
Set wsDest = wbDest.Worksheets("Sheet1")

Set rsSrc = CurrentDb.OpenRecordset("qryLOC_CA")

For i = 1 To rsSrc.Fields.Count
wsDest.Cells(1, i) = rsSrc.Fields(i - 1)
Next i

wsDest.Range("A2").CopyFromRecordset rsSrc

wbDest.Save

End Sub

[ADezii]

1. The Overflow Error is because of the variable Declaration as INTEGER which has now been changed to LONG (Line# 6).
2. There were a couple of Bugs which hopefully I fixed in the Revised Code below.
3. You can now specifiy which Sheet to Output the Data to, simply change the Value of the CONSTANT conSheet (Line# 7).
4. Until this is fully operational, no existing Data on the Sheet will be DELETED, it has been Remmed Out in the Test Database (Line# 17 for 1,000 Records).
5. Because of the nature of this Thread, I am attaching the Test Database that I created using 1,000 Rows. Click the Command Button and see what happens.
6. The Test Database allows for 12 Worksheets Sheet1...Sheet1 2.
7. Make sure that Locations.xls is in the 'same' Folder as the Database.
8. Let me know how you make out.
   

   Dim appExcel As Excel.Application
   Dim rst As DAO.Recordset
   Dim MyDB As DAO.Database
   Dim qdf  As QueryDef
   Dim intNumOfLocQueries As Integer
   Dim lngNextRow As Long
   Const conSHEET As String = "Sheet7"
     
   'Make sure to Set a Reference to the Microsoft Excel XX.X Object Library
   Set MyDB = CurrentDb
   Set appExcel = CreateObject("Excel.Application")
     
   With appExcel
     .Visible = True
     .UserControl = True
       With .Workbooks.Open(CurrentProject.Path & "\Locations.xls")
        '.Worksheets(conSHEET).Range("A1:CB1000").ClearContents   '80 Columns/1,000 Rows
        .Worksheets(conSHEET).Activate
           For Each qdf In CurrentDb.QueryDefs
             If Left$(qdf.Name, 6) = "qryLoc" Then
               intNumOfLocQueries = intNumOfLocQueries + 1
                 If intNumOfLocQueries = 1 Then
                   Set rst = MyDB.OpenRecordset(qdf.Name)
                    lngNextRow = DCount("*", qdf.Name) + 1
                    'lngNextRow = .ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                     .Worksheets(conSHEET).Range("A1").CopyFromRecordset rst
                 Else
                   Set rst = MyDB.OpenRecordset(qdf.Name)
                     .Worksheets(conSHEET).Range("A" & CStr(lngNextRow)).CopyFromRecordset rst
                       lngNextRow = lngNextRow + DCount("*", qdf.Name)
                       'lngNextRow = .ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                 End If
             End If
           Next qdf
       End With
   End With
     
   rst.Close
     
   Set rst = Nothing
   Set appExcel = Nothing
   Set qdf = Nothing
   Set qdf = Nothing

[bytes access nubie]

Hi Adezii. Thank you, this code ran successfully!!! All of the records were appended to the 1 tab which is what I need. And thank you for your sample database!

I ran 7 of my 12 queries and got about 487,000 records. It took about 35 mins to run. A message displayed a couple of minutes into the process that said ”You selected more records than can be copied onto the clipboard at one time….”. I clicked ok but I do see the correct number of records were pulled (we’re using office 2010).

I’m sorry to bother you, but do you think it is possible to append the data to the excel file without actually opening the Excel file? I truly due appreciate your help and your time and certainly understand if this is asking too much. Thanks again.

[ADezii]

The following changes to Lines 14 and 38 will do the trick for you and actually Prompt you to Save any changes or not.

Dim appExcel As Excel.Application
Dim rst As DAO.Recordset
Dim MyDB As DAO.Database
Dim qdf  As QueryDef
Dim intNumOfLocQueries As Integer
Dim lngNextRow As Long
Const conSHEET As String = "Sheet7"
  
'Make sure to Set a Reference to the Microsoft Excel XX.X Object Library
Set MyDB = CurrentDb
Set appExcel = CreateObject("Excel.Application")
  
With appExcel
  .Visible = False
  .UserControl = True
    With .Workbooks.Open(CurrentProject.Path & "\Locations.xls")
     '.Worksheets(conSHEET).Range("A1:CB1000").ClearContents   '80 Columns/1,000 Rows
     .Worksheets(conSHEET).Activate
        For Each qdf In CurrentDb.QueryDefs
          If Left$(qdf.Name, 6) = "qryLoc" Then
            intNumOfLocQueries = intNumOfLocQueries + 1
              If intNumOfLocQueries = 1 Then
                Set rst = MyDB.OpenRecordset(qdf.Name)
                 lngNextRow = DCount("*", qdf.Name) + 1
                 'lngNextRow = .ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
                  .Worksheets(conSHEET).Range("A1").CopyFromRecordset rst
              Else
                Set rst = MyDB.OpenRecordset(qdf.Name)
                  .Worksheets(conSHEET).Range("A" & CStr(lngNextRow)).CopyFromRecordset rst
                    lngNextRow = lngNextRow + DCount("*", qdf.Name)
                    'lngNextRow = .ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
              End If
          End If
        Next qdf
    End With
End With

appExcel.Workbooks.Close
  
rst.Close
  
Set rst = Nothing
Set appExcel = Nothing
Set qdf = Nothing
Set qdf = Nothing

[bytes access nubie]

Thank you VERY much for your help!! When I ran the code, it seems to just run for awhile. After about 1 hour I used End Task to kill the process. A vb error displayed: Run-time error 1004, Method ‘Close’ of object ‘Workbooks ’ failed and the line appExcel.Workbo oks.Close was highlighted. I tried looking online to see if I could figure out how to tweak the code but it seemed right to me (but I wasn’t able to spend a lot of time looking). Any help is greatly appreciated…

[ADezii]

You can try:

appExcel.Workbooks(CurrentProject.Path & "\Locations.xls").Close SaveChanges:=True

[bytes access nubie]

thank you adezii! I hit a very busy period at work. hopefully i can try this tomorrow.