Option Compare Database
Function Outputrecords()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim path As String
Dim i As Integer
Dim lRecCount As Long
Set db = CurrentDb
Set rs1 = db.OpenRecordset("a") ' replace with your table or query name
Set rs2 = db.OpenRecordset("b") ' replace with new table name
lRecCount = DCount("[order no]", "a")
' Replace the path with whichever folder you want to put the spreadsheets in
path = "\\nas01\kdrive\..Subscriptions\Data\Workbooks (CRM)\Delegates\output"
rs1.MoveFirst
Do Until rs1.EOF
rs2.AddNew
For i = 1 To lRecCount
rs2.Fields(i) = rs1.Fields(i)
Next i
rs2.Update
DoCmd.OutputTo acOutputTable, "b", acFormatXLS, path & "RecordNo" & i & ".xls"
DoCmd.RunSQL "DELETE * FROM b;"
rs1.MoveNext
Loop
rs1.Close
rs2.Close
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Function