Trying to output multiple XLS files from a query

[platypus71]

What I am trying to accomplish is creating XLS files based on the field [Reporting Level3]. All records will have a value in this field (something like "Doe,John Q.") and there are a total possibility of roughly 10. I want 10 files with each file including only those records.

I really don't know much VBA coding, so this has be totally baffled. The long strSQL at the top was taken from a working query with all double quotes converted to single quotes.

Thanks for any assistance.

Function Makexlsfiles()
strSQL = "SELECT qryHPLTrainingHistory.DateAdded, qryHPLTrainingHistory.OrigCourseComplete, qryHPLTrainingHistory.NewCourseComplete, qryHPLTrainingHistory.[Emp#], qryHPLTrainingHistory.FullName, qryHPLTrainingHistory.Count, qryHPLTrainingHistory.JobTitle, qryHPLTrainingHistory.[Band], qryHPLTrainingHistory.[Reporting Level2], qryHPLTrainingHistory.[Reporting Level3], qryHPLTrainingHistory.[Reporting Level4], qryEnrollment![Applying HR Essentials] & ' ' & [qryHPLTrainingHistory]![Applying HR Essentials] AS [Applying HR Essentials], qryEnrollment![CapStone Program] & ' ' & [qryHPLTrainingHistory]![CapStone Program] AS [CapStone Program], qryEnrollment![Effective Performance Management] & ' ' & [qryHPLTrainingHistory]![Effective Performance Management] AS [Effective Performance Management], qryHPLTrainingHistory.[Getting to Know Nationwide], qryEnrollment![Managing Performance-Symphony] & ' ' & [qryHPLTrainingHistory]![Managing Performance-Symphony] AS [Managing Performance-Symphony], " _
& " qryEnrollment![Role of an IT Manager] & ' ' & [qryHPLTrainingHistory]![Role of an IT Manager] AS [Role of an IT Manager], qryEnrollment![Targeted Selection] & ' ' & [qryHPLTrainingHistory]![Targeted Selection] AS [Targeted Selection], qryEnrollment![The Authentic Communicator] & ' ' & [qryHPLTrainingHistory]![The Authentic Communicator] AS [The Authentic Communicator] " _
& " FROM qryHPLTrainingHistory LEFT JOIN qryEnrollment ON qryHPLTrainingHistory.[Emp#] = qryEnrollment.[Emp#] " _
& " GROUP BY qryHPLTrainingHistory.DateAdded, qryHPLTrainingHistory.OrigCourseComplete, qryHPLTrainingHistory.NewCourseComplete, qryHPLTrainingHistory.[Emp#], qryHPLTrainingHistory.FullName, qryHPLTrainingHistory.Count, qryHPLTrainingHistory.JobTitle, qryHPLTrainingHistory.[Band], qryHPLTrainingHistory.[Reporting Level2], qryHPLTrainingHistory.[Reporting Level3], qryHPLTrainingHistory.[Reporting Level4], qryEnrollment![Applying HR Essentials] & ' ' & [qryHPLTrainingHistory]![Applying HR Essentials], qryEnrollment![CapStone Program] & ' ' & [qryHPLTrainingHistory]![CapStone Program], qryEnrollment![Effective Performance Management] & ' ' & [qryHPLTrainingHistory]![Effective Performance Management], qryHPLTrainingHistory.[Getting to Know Nationwide], qryEnrollment![Managing Performance-Symphony] & ' ' & [qryHPLTrainingHistory]![Managing Performance-Symphony], qryEnrollment![Role of an IT Manager] & ' ' & [qryHPLTrainingHistory]![Role of an IT Manager], " _
& " qryEnrollment![Targeted Selection] & ' ' & [qryHPLTrainingHistory]![Targeted Selection], qryEnrollment![The Authentic Communicator] & ' ' & [qryHPLTrainingHistory]![The Authentic Communicator];"

Set rs = CurrentDb.OpenRecordset(strSQL)

While Not rs.EOF
    strSQL = "SELECT * FROM (qry WHERE [Reporting Level3]=' & rs![Reporting Level3]');"
    
        If DLookup("Name", "MSysObjects", "Name= 'qryNew'") <> "" Then
        Set qdf = CurrentDb.QueryDefs("qryNew")
        qdf.SQL = strSQL
    Else
        Set qdf = CurrentDb.CreateQueryDef("qryNew", strSQL)
    End If
    
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryNew", rs![Reporting Level3] & ".xls", True
    
    rs.MoveNext
Loop

End Function

 

[Golom]

Assuming that the big SQL is working, you need to change this

strSQL = "SELECT * FROM qry WHERE [Reporting Level3]='[red]"[/red] & rs![Reporting Level3] [red]& "[/red]';"

You can simplify the massive SQL a bit as well

Function Makexlsfiles()
    strSQL = "SELECT DISTINCT H.[Reporting Level3] FROM qryHPLTrainingHistory H;"

    Set rs = CurrentDb.OpenRecordset(strSQL)

    While Not rs.EOF
        strSQL = "SELECT * FROM qry WHERE [Reporting Level3]='" & rs![Reporting Level3] & "');"

        If DLookup("Name", "MSysObjects", "Name= 'qryNew'") <> "" Then
            Set qdf = CurrentDb.QueryDefs("qryNew")
            qdf.SQL = strSQL
        Else
            Set qdf = CurrentDb.CreateQueryDef("qryNew", strSQL)
        End If

        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                                  "qryNew", rs![Reporting Level3] & ".xls", True

        rs.MoveNext
    Loop

End Function

 

[platypus71]

Thanks. This left me a couple of errors, but I was able to fix them.

Needed to add "Do" to the front of the While line and had to change qry to an actual query in the database.