Export Dynamic Recordset to Excel

[pooldead]

I have a recordset that will be used to gather a list of users who are reporting to a manager. This list needs to be exported so that it can be attached to an email. There are multiple managers in the db so there will be multiple spreadsheets created. I need guidance on how to send the recordset information to excel during my do while loop, as well as how to dynamically attach the managers' spreadsheet to their associated email. I need this automated as it will be a large data set, so I need the spreadsheets saved without any user interaction (i.e. no msofilepickersaveas or w/e the command is). The red < > section is where I will be placing this code.

Private Sub managerquery()
 
    Dim managerinfo As Recordset
    Dim affiliateinfo As Recordset
    Dim sqlstr As String
   
    sqlstr = "SELECT DISTINCT tbl_affiliates.Manager " & _
"FROM tbl_affiliates; "
 
    Set managerinfo = CurrentDb.OpenRecordset(sqlstr)
 
    If (mgrRec.RecordCount = 0) Then
            MsgBox ("No records found on tbl_activeAccts, import was empty or failed")
            Exit Sub
    Else
        managerinfo.MoveLast
        managerinfo.MoveFirst
        Do While Not managerinfo.EOF
            sqlstr = "Select tbl_affiliates.username, tbl_affiliates.manager " & _
                    "From tbl_affiliates " & _
                    "Where ((tbl_affiliates.manager)='" & managerinfo.Fields("Manager") & "');"
            Set affiliateinfo = CurrentDb.OpenRecordset(sqlstr)
            If (affilateinfo.RecordCount = 0) Then
                MsgBox ("No records found on tbl_activeAccts, import was empty or failed")
                Exit Do
            Else
                affiliateinfo.MoveLast
                affiliateinfo.MoveFirst
           <  >
            End If
            managerinfo.MoveNext
        Loop
    End If
          
End Sub

[pooldead]

A quick update:

I had the idea to store my data like the following, which I think would work in theory, but I'm not sure will in execution. I am aware this is not complete code, I jotted the idea down quickly.

	fileName = "C:\users\e99714\desktop\" & mgrRec.Fields("manager")
	exportUsers = affiliateInfo.Fields("username") & exportUsers
	
	DoCmd.TransferSpreadsheet acExport, spreadsheet12, exportUsers, fileName, True

[Uncle Gizmo]

Why not send a PDF?

Sent from my Pixel 3a using Tapatalk

[pooldead]

B/c there is going to be some interaction on the sheet from the managers when they receive the spreadsheet.

[ssanfu]

Try this....

I'm not real happy with this code creating, then deleting a query, but it creates the Excel workbooks.
You could create a saved query "TempQuery" and modify the code to NOT create/delete it, just keep changing the query SQL.

Private Sub managerquery()
    Const strTemp = "TempQuery"    ' or whatever you like

    Dim dB As DAO.Database
    Dim managerinfo As DAO.Recordset
    Dim affiliateinfo As DAO.Recordset
    Dim qdf As DAO.QueryDef
    Dim sqlstr As String
    Dim strFileName As String
    Set dB = CurrentDb

    sqlstr = "SELECT DISTINCT tbl_affiliates.Manager FROM tbl_affiliates ORDER BY tbl_affiliates.Manager; "

    Set managerinfo = dB.OpenRecordset(sqlstr)
    If (managerinfo.BOF And managerinfo.EOF) Then
        '        If (mgrRec.RecordCount = 0) Then
        MsgBox ("No records found on tbl_activeAccts, import was empty or failed")
        Exit Sub
    Else
        managerinfo.MoveLast
        managerinfo.MoveFirst
        Do While Not managerinfo.EOF
            sqlstr = "SELECT tbl_affiliates.username, tbl_affiliates.manager "
            sqlstr = sqlstr & " FROM tbl_affiliates"
            sqlstr = sqlstr & " WHERE tbl_affiliates.manager = '" & managerinfo.Fields("Manager") & "'"
            sqlstr = sqlstr & " ORDER BY tbl_affiliates.username;"
            '            Debug.Print sqlstr

            Set affiliateinfo = dB.OpenRecordset(sqlstr)
            If (affiliateinfo.BOF And affiliateinfo.EOF) Then
                '            If (affilateinfo.RecordCount = 0) Then
                MsgBox ("No records found on tbl_activeAccts, import was empty or failed")
                Exit Do
            Else
                ' Create a new temporary query with the modified SQL string
                Set qdf = dB.CreateQueryDef(Name:=strTemp, SQLText:=sqlstr)

                'Change to your path
                strFileName = "C:\users\e99714\desktop\" & managerinfo.Fields("manager") & ".xlsx"
                '                strFileName = "D:\Misc\" & managerinfo.Fields("manager") & ".xlsx"    '                                                  <<-- for my testing

                'Syntax: DoCmd.TransferSpreadsheet(TransferType, SpreadsheetType, TableName, FileName, HasFieldNames, Range, UseOA)
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, strTemp, strFileName, True


                'for acSpreadsheetTypeExcel12Xml parameter see:       -->>         https://docs.microsoft.com/n-us/office/vba/api/access.acspreadsheettype
                
                'delete temp query
                dB.QueryDefs.Delete strTemp
            End If
            affiliateinfo.Close
            managerinfo.MoveNext
        Loop
    End If

    Msgbox "Done!!"

    'clean up
    On Error Resume Next
    affiliateinfo.Close
    managerinfo.Close
    Set managerinfo = Nothing
    Set affiliateinfo = Nothing
    Set dB = Nothing
End Sub