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...