Acces VBA Export 2 tables to one excel with criteria

[dekker_123]

I've been testing and searching for a couple of weeks and i think its now time after hundreds of tests, to ask help. Here's my situation.


I have two tables in MS Access 2016:



Journal_personeel_verloning (or table1)


Table 1:


ID Persid Chauffeur Proj Starttime Endtime
1 85 John A 10:00 12:00
2 86 Fred X 10:00 12:00
3 85 John A 10:00 12:00
4 86 Fred A 10:00 12:00


Journal_personeel_verloning_2_all (or table2)


Table 2:
ID Persid Chauffeur Proj Totalworkedtime(decimal)
1 85 John A 4
2 86 Fred A 2
3 86 Fred X 2


Notes:


Table 1 and table 2 have exactly the same employees always.


Persid is the fieldname should filter on (both tables has this fieldname)


What do I want to achieve: I want to export two tables to one Excel file with following conditions:


1 Excel file containing data of 2 tables
Each PersID on seperate sheet/tab
Each sheet/tab name would be PersID


Export must look like this:



1 excel file with:
tabname: John


ID Persid Chauffeur Proj Starttime Endtime
1 85 John A 10:00 12:00
3 85 John A 10:00 12:00


(1 or 2 empty rows)


ID Persid Chauffeur Proj Totalworkedtime(decimal)
1 85 John A 4


same excel with second tabname: Fred


ID Persid Chauffeur Proj Starttime Endtime
2 86 Fred X 10:00 12:00
4 86 Fred A 10:00 12:00


(1 or 2 empty rows)


ID Persid Chauffeur Proj Totalworkedtime(decimal)
2 86 Fred A 2
3 86 Fred X 2




the code for only first table worked but i could not arrange both tables in one code with loop.


here is my code:



Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String
-----------------


Const strFileName As String = "Employee_Verloning"


DoCmd.SetWarnings False




Const strQName As String = "zExportQuery"


Set dbs = CurrentDb
strTemp = dbs.TableDefs(0).Name


strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"


Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close


strTemp = strQName


strSQL = "SELECT DISTINCT Persid FROM Journal_personeel_verloning;"


Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)




If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False


strMgr = DLookup("CHAUFFEURR", "Journal_personeel_verloning", _
"Persid = " & rstMgr!Persid.value)
strSQL = "SELECT * FROM Journal_personeel_verloning WHERE " & _
"Persid = " & rstMgr!Persid.value & ";"




Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing




DoCmd.TransferSpreadsheet _
Transfertype:=acExport, _
SpreadsheetType:=acSpreadsheetTypeExcel9, _
TableName:=strTemp, _
Filename:="M:\Public\Exports XLS\Personeel\" & strFileName & ".xls", _
HasFieldNames:=True, _
Range:=strMgr


rstMgr.MoveNext




Loop




End If




rstMgr.Close
Set rstMgr = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing



any help would be appreciate...thanks in advance...

[OBP]

dekker, I have a question.
Am I correct in assuming that the second table just contains the sum of hours for each person for each project?
If it is then the second table is not required as the sum can be calculated in a query or Report.
You do not appear to be specifying the Sheet name.
You are also using the TransferSpreadsheet method whereas you can actually insert the data directly in to Excel at specified locations using VBA.
You could also use the ExportReport method to put the data in to Excel, but as you appear to want a Sheet for each person you would need to run separate reports for each person.

[dekker_123]

Yes, 2.nd table is just sum.

So there is 1 excel file name: Const strFileName As String = "Employee_Verloning". Every sheet has the name of employee.So 1 sheet for each employee. The code above worked for table 1. I understand that maybe TransferSpreadsheet is not the right one to use in my situation for 2 table or queries. But if its possible with the code above to export 1 table to different sheetnames per employee, there must be a way in the same code to add a second table/query to ad in same time or maybe later the second table/query data?

[dekker_123]

Look, its not a problem if we can add later the second or maybe there would be later more tables/queries to add to same sheetname/employee. Let say, the code above create 1 excel with 2 sheetsnames/employees. lets call the cmdbutton: export 1. I made a second cmdbutton: export 2 with the next code to add to existing excel file: Employee_Verlonging:


Const strFileName As String = "Employee_Verloning"


Dim rstName As Recordset
Set rstName = CurrentDb.OpenRecordset("testtesttest_totalen_exp_xls_2")


Dim objApp As Object, objMyWorkbook As Object, objMySheet As Object, objMyRange As Object


Set objApp = CreateObject("Excel.Application")
Set objMyWorkbook = objApp.Workbooks.Open("M:\Public\Exports XLS\Personeel\" & strFileName & ".xls")
Set objMySheet = objMyWorkbook.Worksheets("Marian_Chlebek")
Set objMyRange = objMySheet.Cells(objApp.ActiveSheet.UsedRange.Rows.Count + 2, 1)


With objMyRange
rstName.MoveFirst 'Rewind to the first record
.Clear
.CopyFromRecordset rstName
End With


objMyWorkbook.Close True
Set objMyWorkbook = Nothing
objApp.Quit
Set objApp = Nothing




But, the problem is, "Set objMySheet = objMyWorkbook.Worksheets("Marian_Chlebek")" these lines. in this code example, we must give 1 specific sheet/employee name. But how could we edit the code so that it makes a loop and adds to existing sheets the according data?

So the result is more important than the way to it. If i had to make 3 cmd buttons no problem. But the per employee 1 report creation and export each report to each sheet, i have no idea or did before? so if that is the best option to you, i would be appreciate some sample.. thnx in advance

[OBP]

Within the loop that had originally you should be able to extract the Employee Name to use the "Set objMySheet = objMyWorkbook.Worksheets("Marian_Chlebek")"
ie create a string, say
dim person as string
and then within the loop set person equals qdf.chauffeur ie
person = qdf.chauffeur.
Then change your code to something like
Set objMySheet = objMyWorkbook.Worksheets("& person & ")"

You can use the "Marian_Chlebek" to test the syntax required first ie

person = "Marian_Chlebek"
Set objMySheet = objMyWorkbook.Worksheets(" & person & ")"

to see if that syntax works.

ps there is another possible way to do this and that is to name the Range where you want the data to be entered and then use this version of TransferSpreadsheet
DoCmd.TransferSpreadsheet acExport, , "CMSolderQuery", "c:\Users\A C\Desktop\Report.xlsx", True, "accessquery"
where accessquery is the named range

[dekker_123]

Within the loop that had originally you should be able to extract the Employee Name to use the "Set objMySheet = objMyWorkbook.Worksheets("Marian_Chlebek")"
ie create a string, say
dim person as string
and then within the loop set person equals qdf.chauffeur ie
person = qdf.chauffeur.
Then change your code to something like
Set objMySheet = objMyWorkbook.Worksheets("& person & ")"

You can use the "Marian_Chlebek" to test the syntax required first ie

person = "Marian_Chlebek"
Set objMySheet = objMyWorkbook.Worksheets(" & person & ")"

to see if that syntax works.

ps there is another possible way to do this and that is to name the Range where you want the data to be entered and then use this version of TransferSpreadsheet
DoCmd.TransferSpreadsheet acExport, , "CMSolderQuery", "c:\Users\A C\Desktop\Report.xlsx", True, "accessquery"
where accessquery is the named range

OK thanks, i'll give it a try :) let you know..