Loop code - source for query

[GregRun]

OK, this is much simpler than I originally understood:

Notes:
1. You didn't give me tble_practice so instead I got the list of KCodes from tble_Activity.
2. You will still need to tweak it a little bit as I can see that the numbers aren't coming through in the right rows. However, since I don't know where the data is supposed to go, it's up to you!

Option Compare Database
Option Explicit

Dim xlApp As Excel.Application

Private Sub Export_statements_Click()
    Dim db As DAO.Database
    Dim rstTable As DAO.Recordset
    Dim rstExcel As DAO.Recordset
    Dim mySQL As String
    Dim FileName As String
    
    'Set up
    Set db = CurrentDb
    Set xlApp = CreateObject("Excel.Application")
    Set rstTable = db.OpenRecordset("SELECT KCode FROM tble_Activity GROUP BY KCode")
    rstTable.MoveFirst
    
    'Don't need to check for .eof and .bof here, you've already got everying in a loop
    'If the table has no records, rstTable will just skip the loop
    Do Until rstTable.EOF
        'You can change the file name to whatever you want as long
        'as it will create different file names for each record
        FileName = "Quarterly Submisstion - " & rstTable("KCode")
        'Set up your SQL and bring in the value of KCode for this record
        mySQL = "SELECT Tble_Activity.KCode, Tble_Indicator.ID_activity, " & _
            "Sum(IIf(Left([QuarterCode],2)='Q1',[Activity],0)) AS Q1, " & _
            "Sum(IIf(Left([QuarterCode],2)='Q2',[Activity],0)) AS Q2, " & _
            "Sum(IIf(Left([QuarterCode],2)='Q3',[Activity],0)) AS Q3, " & _
            "Sum(IIf(Left([QuarterCode],2)='Q4',[Activity],0)) AS Q4 " & _
            "FROM Tble_Indicator INNER JOIN Tble_Activity ON (Tble_Indicator.ID_payment = Tble_Activity.PaymentID) " & _
            "AND (Tble_Indicator.Indicator = Tble_Activity.Fieldname) " & _
            "GROUP BY Tble_Activity.KCode, Tble_Indicator.ID_activity " & _
            "HAVING Tble_Activity.KCode= '" & rstTable("KCode") & "'"
        db.QueryDefs("Query_Activity").SQL = mySQL
        
        mySQL = "SELECT tble_pay.KCode, Tble_Indicator.ID_Pay, " & _
            "Sum(IIf(Left([QuarterCode],2)='Q1',[payment_sheet],0)) AS Q1, " & _
            "Sum(IIf(Left([QuarterCode],2)='Q2',[payment_sheet],0)) AS Q2, " & _
            "Sum(IIf(Left([QuarterCode],2)='Q3',[payment_sheet],0)) AS Q3, " & _
            "Sum(IIf(Left([QuarterCode],2)='Q4',[payment_sheet],0)) AS Q4 " & _
            "FROM Tble_Indicator INNER JOIN tble_pay ON Tble_Indicator.ID_payment = tble_pay.PaymentID " & _
            "GROUP BY tble_pay.KCode, Tble_Indicator.ID_Pay HAVING tble_pay.KCode='" & rstTable("KCode") & "' " & _
            "ORDER BY Tble_Indicator.ID_Pay"
        db.QueryDefs("Query_Payment").SQL = mySQL
        
        'Set up your recordset for export using your export query
        Set rstExcel = db.OpenRecordset("Query_export")
        'Call our Export function and give it our recordset and new file name
        ExportExcel rstExcel, FileName
        'Move to the next record
        rstTable.MoveNext
    Loop

    xlApp.Quit
    rstTable.Close
    rstExcel.Close
    
    Set xlApp = Nothing
    Set rstTable = Nothing
    Set rstExcel = Nothing
End Sub

Private Sub ExportExcel(rst As DAO.Recordset, NewFileName As String)
    Dim xlWorkbook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim lvlColumn As Integer
    Dim MasterPath As String
    Dim DestinationPath As String
    
    'Change master path to location of your master spreadsheet and
    'DestinationPath to where you want the Excel files to be saved
    MasterPath = "C:\MASTER\Quarterly submission MASTER 2012-2013.xls"
    DestinationPath = "C:\EXPORTED\"
    
    'Set up Excel document
    Set xlWorkbook = xlApp.Workbooks.Open(MasterPath)
    Set xlSheet = xlWorkbook.Sheets(1)

    'Insert Data
    With xlSheet
        'Insert your Code for putting things in the correct cells here.
        'This is how I bring data into the sheet:
        .Range("D6").CopyFromRecordset rst
    End With

    'Save Excel document as [New File Name].xls
    If Right(DestinationPath, 1) <> "\" Then
        DestinationPath = DestinationPath & "\"
    End If
    xlWorkbook.SaveAs DestinationPath & NewFileName & ".xls"
    xlWorkbook.Close
    
    rst.Close
    
    Set rst = Nothing
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
End Sub

 

[scubadiver007]

The query definitions are being created but the data isn't being exported to Excel and I don't understand debugging enough to figure out where the problem is.

It is incredibly frustrating.

 

[scubadiver007]

It works ok now and I am using a separate form to do it.

Thanks