Consulting

Results 1 to 6 of 6

Thread: Acces VBA Export 2 tables to one excel with criteria

  1. #1

    Exclamation Acces VBA Export 2 tables to one excel with criteria

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

  2. #2
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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.

  3. #3
    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?

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

  5. #5
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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

  6. #6
    Quote Originally Posted by OBP View Post
    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..

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •