Create Workbook With Multiple Worksheets (vba)

MS Access:  This code can be used to split out and save a workbook with multiple sheets

Sub PrintAll()

Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim intID As Integer
Dim strFilePath As String
Dim dbs As Database
Dim qdf As QueryDef
Dim strQDF As String
Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("qry_BO")

strSQL = "SELECT tbl_intlPartners.* " & _
        "FROM tbl_intlPartners " & _
        "ORDER BY tbl_intlPartners.Name; "

rst.Open strSQL, CurrentProject.Connection
Do While Not rst.EOF
    intID = rst.Fields("BOID").Value
    BudgetOwner = rst.Fields("BudgetOwner").Value
    strQDF = "SELECT tbl_intlPartners.* " & _
            "FROM tbl_intlPartners " & _
            "WHERE BOID=" & intID
    qdf.SQL = strQDF
    strFilePath = "C:\Documents and Settings\jhampton\Desktop\BO\International" & ".xls"
    rst.MoveNext
DoCmd.TransferSpreadsheet acExport, , "qry_BO", strFilePath, True, BudgetOwner

Loop
rst.Close
Set rst = Nothing

End Sub