循環訪問錯誤424循環rs到excel

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 

有沒有更好的方法來做到這一點。我解決了我之前的問題，但現在我得到了一個需要424個對象的錯誤。在對象錯誤之前，我沒有收到記錄錯誤，我檢查了所有返回記錄的查詢。

有沒有更好的方法來循環通過rs並獲得輸出到excel文件，我有大約18個委員需要有一個主席和1-5個成員。細胞在excel ie ... Y16爲主席，然後在y17成員名單。

Answer 1

1- 除了循環，您可以使用'CopyfromRecordSet'。您只需在Excel文件的每張表格上選擇起始單元格，然後系統完成剩下的工作。 我給你的微軟鏈接：https://msdn.microsoft.com/en-us/library/office/aa223845(v=office.11).aspx

2- 在424所需的對象問題，你有沒有嘗試調試代碼，找出哪一行發生錯誤？

希望這可以幫助！