Loop Access error 424 Loop rs to excel - vba

Question

rivate Sub CmdOpenCmtList_Click()
On Error GoTo SubError
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlWks As Excel.Worksheet
Dim i As Integer 'First Row: CmtAwd
Dim j As Integer 'First Row: CmtJaws
Dim k As Integer 'First Row: CmtSick
Dim l As Integer 'Second Row: CmtCust
Dim m As Integer 'Second Row: CmtJun
Dim n As Integer 'Second Row: CmtMain
Dim SQLCmtAwd As String
'Dim SQLCmtAwdChair As String 'no chairman
Dim SQLCmtJaws As String
Dim SQLCmtJawsChair As String
Dim SQLCmtSick As String
Dim SQLCmtSickChair As String
Dim SQLCmtCust As String
Dim SQLCmtCustChair As String
Dim SQLCmtJun As String
Dim SQLCmtJunChair As String
Dim SQLCmtMain As String
Dim SQLCmtMainChair As String
Dim rsCmtAwd As DAO.Recordset
'Dim rsCmtAwdChair As DAO.Recordset 'no chairmen
Dim rsCmtJaws As DAO.Recordset
Dim rsCmtJawsChair As DAO.Recordset
Dim rsCmtSick As DAO.Recordset
Dim rsCmtSickChair As DAO.Recordset
Dim rsCmtCust As DAO.Recordset
Dim rsCmtCustChair As DAO.Recordset
Dim rsCmtJun As DAO.Recordset
Dim rsCmtJunChair As DAO.Recordset
Dim rsCmtMain As DAO.Recordset
Dim rsCmtMainChair As DAO.Recordset
SQLCmtAwd = "SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtAwd, TblMembers.CmtAwd " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtAwd)=True))"
'SQLCmtAwdChair = " SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtAwdChair, [FullName] & "" - Chairman"" AS FullNameChair " & _
' " FROM TblMembers " & _
' " WHERE (((TblMembers.CmtAwdChair)=True))"
SQLCmtJaws = "SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtJaws " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtJaws)=True))"
SQLCmtJawsChair = " SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtJawsChair, [FullName] & "" - Chairman"" AS FullNameChair " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtJawsChair)=True))"
SQLCmtSickChair = " SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtSickChair, [FullName] & "" - Chairman"" AS FullNameChair " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtSickChair)=True))"
SQLCmtSick = "SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtSickChair " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtSick)=True))"
SQLCmtCustChair = " SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtCustChair, [FullName] & "" - Chairman"" AS FullNameChair " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtCustChair)=True))"
SQLCmtCust = "SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtCust " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtCust)=True))"
SQLCmtJunChair = " SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtJunChair, [FullName] & "" - Chairman"" AS FullNameChair " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtJunChair)=True))"
SQLCmtJun = "SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtJun " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtJun)=True))"
SQLCmtMainChair = " SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtMainChair, [FullName] & "" - Chairman"" AS FullNameChair " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtMainChair)=True))"
SQLCmtMain = "SELECT [FirstName] & "" "" & [LastName] AS FullName, TblMembers.CmtMainChair " & _
" FROM TblMembers " & _
" WHERE (((TblMembers.CmtMain)=True))"
Set rsCmtAwd = CurrentDb.OpenRecordset(SQLCmtAwd, dbOpenSnapshot)
'Set rsCmtAwdChair = CurrentDb.OpenRecordset(SQLCmtAwdChair, dbOpenSnapshot)
Set rsCmtJaws = CurrentDb.OpenRecordset(SQLCmtJaws, dbOpenSnapshot)
Set rsCmtJawsChair = CurrentDb.OpenRecordset(SQLCmtJawsChair, dbOpenSnapshot)
Set rsCmtSick = CurrentDb.OpenRecordset(SQLCmtSick, dbOpenSnapshot)
Set rsCmtSickChair = CurrentDb.OpenRecordset(SQLCmtSickChair, dbOpenSnapshot)
Set rsCmtCust = CurrentDb.OpenRecordset(SQLCmtCust, dbOpenSnapshot)
Set rsCmtCustChair = CurrentDb.OpenRecordset(SQLCmtCustChair, dbOpenSnapshot)
Set rsCmtJun = CurrentDb.OpenRecordset(SQLCmtJun, dbOpenSnapshot)
Set rsCmtJunChair = CurrentDb.OpenRecordset(SQLCmtJunChair, dbOpenSnapshot)
Set rsCmtMain = CurrentDb.OpenRecordset(SQLCmtMain, dbOpenSnapshot)
Set rsCmtMainChair = CurrentDb.OpenRecordset(SQLCmtMainChair, dbOpenSnapshot)
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Open(CurrentProject.Path & "\Master\CommitteeList.xlsx")
Set xlWks = xlWkb.Sheets("Sheet1")
xlApp.Visible = True
i = 10 'First Row: CmtAwd
j = 10 'First Row: CmtJaws
k = 10 'First Row: CmtSick
With xlWks
Do While Not rsCmtAwdChair.EOF
.Range("E9").Value = (rsCmtAwdChair!FullNameChair)
rsCmtAwdChair.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtAwd.EOF
.Range("E" & i - 1).Value = Nz(rsCmtAwd!FullName, "")
i = i + 1
rsCmtAwd.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtJawsChair.EOF
.Range("Y9").Value = (rsCmtJawsChair!FullNameChair)
rsCmtJawsChair.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtJaws.EOF
.Range("Y" & j).Value = Nz(rsCmtJaws!FullName, "")
j = j + 1
rsCmtJaws.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtSickChair.EOF
.Range("AS9").Value = (rsCmtSickChair!FullNameChair)
rsCmtSickChair.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtSick.EOF
.Range("AS" & k).Value = Nz(rsCmtSick!FullName, "")
k = k + 1
rsCmtSick.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtCustChair.EOF
.Range("E16").Value = (rsCmtCustChair!FullNameChair)
rsCmtCustChair.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtCust.EOF
.Range("AS" & i).Value = Nz(rsCmtCust!FullName, "")
i = i + 17
rsCmtSick.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtJunChair.EOF
.Range("Y16").Value = (rsCmtJunChair!FullNameChair)
rsCmtJunChair.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtJun.EOF
.Range("Y" & m).Value = Nz(rsCmtJun!FullName, "")
m = m + 1
rsCmtSick.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtMainChair.EOF
.Range("AS16").Value = (rsCmtMainChair!FullNameChair)
rsCmtMainChair.MoveNext
Loop
End With
With xlWks
Do While Not rsCmtMain.EOF
.Range("Y" & n).Value = Nz(rsCmtMain!FullName, "")
n = n + 1
rsCmtMain.MoveNext
Loop
End With
SubExit:
On Error Resume Next
rsCmtAwd.Close
'rsCmtAwdChair.Close
rsCmtJaws.Close
rsCmtJawsChair.Close
rsCmtSick.Close
rsCmtSickChair.Close
rsCmtCust.Close
rsCmtCustChair.Close
rsCmtJun.Close
rsCmtJunChair.Close
rsCmtMain.Close
rsCmtMainChair.Close
Set rsCmtAwd = Nothing
'Set rsCmtAwdChair = Nothing
Set rsCmtJaws = Nothing
Set rsCmtJawsChair = Nothing
Set rsCmtSick = Nothing
Set rsCmtSickChair = Nothing
Set rsCustAwd = Nothing
Set rsCmtCustChair = Nothing
Set rsCmtJun = Nothing
Set rsCmtJunChair = Nothing
Set rsCmtMain = Nothing
Set rsCmtSickMain = Nothing
Exit Sub
SubError:
MsgBox "Error Number: " & Err.Number & "=" & Err.Description, vbCritical + vbOKOnly, "An error occured"
GoTo SubExit
End Sub
Is there a better way to do this. I solved my previous problem, but now I get an error of 424 object required. Before the object error I was getting no record error, I checked the queries all return records.
Is there a better way to loop thru rs and get the output to the excel file, I have about 18 committes that need to have a chairman and 1-5 members. Cells on excel ie... Y16 for Chairman and then in y17 the list of members.

Answer 1

1-
Instead of looping, you can use 'CopyfromRecordSet'. You just need to select the starting cell on each sheet of your Excel file, and the system do the rest.
I give you the Microsoft link:https://msdn.microsoft.com/en-us/library/office/aa223845(v=office.11).aspx
2-
On the 424 Object required problem, did you try to debug the code to find out which line the error occurs?
Hope this can help!