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上的单元格，即... Y16代表主席，然后是y17成员名单。

Answer 1

1- 您可以使用＆＃39; CopyfromRecordSet＆＃39;而不是循环。您只需在Excel文件的每张纸上选择起始单元格，系统即可完成剩下的工作。我给你微软链接：https://msdn.microsoft.com/en-us/library/office/aa223845(v=office.11).aspx

2- 在424对象所需问题上，您是否尝试调试代码以找出错误发生的哪一行？

希望这有帮助！

循环访问错误424循环rs到excel

1 个答案: