Private Sub Command1_Click()
On Error GoTo Err_Command1_Click
Dim rst As DAO.Recordset
Dim Path As String
Dim StrBU As String
Dim intDcode As String
Dim strQry As String
Dim StrExt As String
Dim strFile As String
Dim qDef As DAO.QueryDef
Err.Clear
On Error Resume Next
Set qDef = CurrentDb.QueryDefs("Birthday Report")
If Err.Number <> 0 Then Set qDef = CurrentDb.CreateQueryDef("Birthday Report")
On Error GoTo 0
strQry = "SELECT Departments1.[RestNumber]FROM Departments1 ORDER BY Departments1.[RestNumber];"
Set rst = CurrentDb().OpenRecordset(strQry, dbOpenDynaset)
rst.MoveLast
rst.MoveFirst
Do While Not rst.EOF
Path = "C:\RestaurantReports\"
StrBU = rst("RestNumber")
'StrExt = "_EmployeeRoster_" & Me.ExportDate & ".xls"
StrExt = " - July Birthday Report" & ".xls"
strFile = Path & StrBU & StrExt
intDcode = rst("RestNumber")
qDef.SQL = "SELECT * FROM QryBirthdayReport WHERE RestNumber = " & intDcode & ""
DoCmd.OutputTo acOutputQuery, "Birthday Report", acFormatXLS, strFile, False
rst.MoveNext
Loop
MsgBox ("Export Complete")
Set rst = Nothing
Exit_Command1_Click:
Exit Sub
Err_Command1_Click:
MsgBox Err.Description
Resume Exit_Command1_Click
End Sub
|