Export multiple tables to one Excel Worksheet

[kvar]

I am using Access and Excel 2007.
Here is the general scenario, I know I have used a complicated method, but it seemed much cleaner at the time and I am open to suggestions. This Db is for a mental health practice to track and store the paper questionnaires that the patients fill out. The data then needs to be exported to Excel so that it can be imported into a proprietary software that analyzes the data and recommends treatment plans. (It does NOT play nice with Access, forget it.) There are many forms and all of them are fine and export to separate worksheets no problems.

Now for the problem child: One form has 493 fields. Obviously I could fit that into two tables, but it seemed cleaner to use a main form and main table with the patient information (ID_Number, Name, Date, etc.), then tabbed subforms and separate tables for each “section” of the questionnaire (School, Work, Home, etc. There are 11 tables/forms in all.) These tables are all related by the ID_Number. The problem is the export. I need all 493 fields to write to one worksheet in order. This would of course involve removing the ID_Number field from all the tables except the main one. A query obviously can’t handle that many fields. VBA I can TransferSpreadsheet but then each table goes to a separate worksheet.

Sorry for the length but I wanted to give the whole picture. I’m thinking maybe calling some SQL code that will drop the unneeded fields and keep appending the data to the worksheet one table at a time? Of course the rows would somehow need to be defined WHERE ID_Number = ID_Number so that the same patients information is all on one row. Any help is GREATLY appreciated! I’m stumped!

 

[Estuardo]

G'd afternoon Kvar,
I don't know if this will help but, what about build a biiiiiiiig array, filling it with your 2/3 queries.
The idea is to use an array to transfer (row by row) all the info to Excel worksheet. I don't need to tell you that to do this you can't do it with the DoCmd. Excel automation will be obligatory.

The other option is to move your 11 tables to ms sql server (supports 1024 cols) and keep them linked to your access file.

G'd Luck

 

[kvar]

Thanks for your response Esuardo.

An array might work. But quite honestly my array experience is almost nill. I understand what they are and how they work, but creating and utilizing them is a whole different animal.

Another issue that just popped into my head this morning though is if I take it "row by row" from each table, there may be a section of the form the patient didn't fill out (i.e. it wasn't applicable to them) so then the data would shift and I would have rows that contain data from two different patients.
There definitely has to be some check to ensure that the patient ID's match before data is inserted into that row.

They don't have SQL Server so that won't work either. Would be great if they had something like that though!

 

[Estuardo]

Kvar,
First of all, we're here to help, just like you do to others. If you have any issue with arrays, we can work together.
Your idea from getting the info from a table will be slower than from 2 or 3 queries, plus queries may include all the filters you need to apply before exporting.
You're absolutely right to implement all and any validation input. That's one the reasons we always get a job . No matter how hard we try, they (users) always find the way to do it.
If you're tight with time, and need to do this just once you can get any sql server express version for free. Any way if you need any assistance i'm in .

 

[kvar]

Thank you.
I think I may be getting "close" to a solution.....famous last words!
I've gotten the data that I need down to 2 queries, about half the tables in each one and of course the main Patient table in both to match the ID numbers with. Both queries work as they should, show everyone's records, etc.
So what I'm thinking is in VBA I define each query as a separate recordset, then have them export into Excel in ranges so that they insert next to each other. I think that should work.
What I can't quite figure out is how to make sure that the ID numbers match from both recordsets before inserting them on the same row.
Somehow it needs to compare the record from each recordset, make sure the ID numbers match, then insert the row. Possibly an EOF type Loop? But the comparison part is what I'm stumped on.
This may not even be a viable idea, but it seems like it should be doesn't it? There must be a way to compare the recordsets before inserting on a row, then just have the next one insert on the next row.
Maybe?

 

[kvar]

I have a solution, finally, should anyone else need something similar. It may not be the most elegant or best solution but it does work!

I had to make 3 queries to get the fields from all 11 tables. Including the "Main" table in each of the 3 queries so that the records are related by the ID field. Then I used the following code to define each query and insert them into the worksheet one next to the other.

Private Sub Command10_Click()
Dim db As Database
Dim rst1 As Recordset
Dim rst2 As Recordset
Dim rst3 As Recordset

Dim fld As Field
Dim intColCount As Integer
Dim intColCount2 As Integer
Dim intColCount3 As Integer
Dim exlApp As Excel.Application
Dim exlBook As Excel.Workbook
Dim exlSheet As Excel.Worksheet
Dim exlRange As Excel.Range
 
    On Error GoTo ErrorHandler
  
    'start by opening your queries
    Set db = CurrentDb()
    Set rst1 = db.OpenRecordset("ABAS_qry", dbOpenDynaset)
    Set rst2 = db.OpenRecordset("Query2", dbOpenDynaset)
    Set rst3 = db.OpenRecordset("Query1", dbOpenDynaset)
    
    intColCount = 1
    
    Set exlApp = New Excel.Application
    exlApp.Visible = True
    
    'create a new workbook
    exlApp.Workbooks.Add   'If you use late binding use: Set exl = CreateObject("Excel.application")
    Set exlBook = exlApp.ActiveWorkbook
    
    'add sheets and label
    Set exlSheet = exlApp.ActiveSheet
    
    For Each fld In rst1.Fields
        exlSheet.Cells(1, intColCount).Value = fld.Name
        intColCount = intColCount + 1
    Next fld
    
    intColCount2 = intColCount
    'Send recordset to worksheet.
    exlSheet.Range("A2").CopyFromRecordset rst1
        
    For Each fld In rst2.Fields
        exlSheet.Cells(1, intColCount).Value = fld.Name
        intColCount = intColCount + 1
    Next fld
    
    intColCount3 = intColCount
    'Send recordset to worksheet.
    exlSheet.Cells(2, intColCount2).CopyFromRecordset rst2
        
    For Each fld In rst3.Fields
        exlSheet.Cells(1, intColCount).Value = fld.Name
        intColCount = intColCount + 1
    Next fld
    
    exlSheet.Cells(3, intColCount3).CopyFromRecordset rst3
    
    exlApp.Visible = True
    
Exit Sub ' to avoid error handling routine
ErrorHandler:   'error handling routine
            MsgBox Err.Number & " " & Error(Err.Number)
    
End Sub

 

[Estuardo]

May not be elegant (i don't see why) but absolutely cleaver
I'm glad you solved and thanks for share your solution

 

[kvar]

New Problem!
The above code worked perfectly until now.
I added the WHERE criteria to my 2 queries. The criteria is based on a date a user enters into a form. Both queries work perfectly from within access. But when I run the VBA it is not getting the Parameters. Yes, the Form is open when it runs.
From what I've managed to Google it looks like I need to have QueryDefs and define the Parameters. But I have tried every sample of code I have found and I can't seem to get anything to work. I've considered going back to a DoCmd.TransferSpreadsheet to transfer these, but can't seem to get the Range to work to put them on the same sheet.

Any ideas??

 

[Estuardo]

G'd evening Kvar,
How are you getting the params? does the vba query run setting the parameters from the code itself? can you post your vba code?

 

[kvar]

The parameters are just coming from two fields on a form, user enters start date and end date. That was the problem, VBA couldn't determine what the parameters were. Below is my code as it is now, I think I've got the problem sorted out. After much head banging and many many web searches!
If you have any other suggestions that may work better please feel free! This is really just patched together from examples that I've found online.

Important Note: To anyone that may need to use this in the future, you must define the parameters in the query design first! In design view of the query, under the design tab of your ribbon, click on parameters. In this case I put in Forms.Export_frm.Begin_Date_txt and set the data type as Date/Time. And then the same for End_Date_txt. Can't tell you how much agony not knowing this simple stepped caused me!!!

Dim db As DAO.Database
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim fld As Field
Dim intColCount As Integer
Dim intColCount2 As Integer
Dim intColCount3 As Integer
Dim exlApp As Excel.Application
Dim exlBook As Excel.Workbook
Dim exlSheet As Excel.Worksheet
Dim exlRange As Excel.Range
Dim qdf1 As DAO.QueryDef
Dim qdf2 As DAO.QueryDef
    
    On Error GoTo ErrorHandler
    DoCmd.SetWarnings False
    
    'open your queries
    Set db = CurrentDb()
    
    Set qdf1 = db.QueryDefs("ABAS_qry")
    Set qdf2 = db.QueryDefs("ABAS2_qry")
    qdf1.Parameters(0) = Forms!Export_frm!Begin_Date_txt
    qdf1.Parameters(1) = Forms!Export_frm!End_Date_txt
    qdf2.Parameters(0) = Forms!Export_frm!Begin_Date_txt
    qdf2.Parameters(1) = Forms!Export_frm!End_Date_txt
                                                                                                                                
    Set rst1 = qdf1.OpenRecordset
    Set rst2 = qdf2.OpenRecordset
    intColCount = 1
    
    Set exlApp = New Excel.Application
    exlApp.Visible = True
    
    'create a new workbook
    exlApp.Workbooks.Add   'If you use late binding use: Set exl = CreateObject("Excel.application")
    Set exlBook = exlApp.ActiveWorkbook
    
    'add sheets and label
    Set exlSheet = exlApp.ActiveSheet
        
    For Each fld In rst1.Fields
        exlSheet.Cells(1, intColCount).Value = fld.Name
        intColCount = intColCount + 1
    Next fld
    
    intColCount2 = intColCount
    'Send recordset to worksheet.
    exlSheet.Range("A2").CopyFromRecordset rst1
        
    For Each fld In rst2.Fields
        exlSheet.Cells(1, intColCount).Value = fld.Name
        intColCount = intColCount + 1
    Next fld
    
    intColCount3 = intColCount
    'Send recordset to worksheet.
    exlSheet.Cells(2, intColCount2).CopyFromRecordset rst2
        
    exlApp.Visible = True
    
    DoCmd.RunSQL "UPDATE Export_tbl SET ABAS = Date() ;"
Exit Function ' to avoid error handling routine
ErrorHandler:   'error handling routine
            MsgBox Err.Number & " " & Error(Err.Number)

 

[Estuardo]

I avoid as much as i can to refer a form from another object. My common approach is:
A public variable, a public Enum/Type or a Class.
In your case i would do something like this:
In a module

Public Type RepDates
  BDate as string
  EDate as string
End Type

Public tReportDates as RepDates

In your procedures i would change this:

    qdf1.Parameters(0) = tReportDates.BDate
    qdf1.Parameters(1) =tReportDates.EDate
    qdf2.Parameters(0) =tReportDates.BDate
    qdf2.Parameters(1) = tReportDates.EDate
   
    tReportDates.BDate= vba.vbNullString
    tReportDates.EDate= vba.vbNullString

What do you think?