MS Access While 루프 첫 번째 레코드 건너 뛰기

클래스 스케줄 및 강의 계획서를 교수에게 전자 메일로 보내는 데 사용되는 분할 다중 사용자 MS 액세스 (2013 ACCDE 파일) 데이터베이스가 있습니다. 전자 메일을 보낼 준비가되면 최종 사용자가 양식의 단추를 누른 다음 DB에 서브 폼 내의 필터링 된 데이터 시트의 각 항목 (약 70)을 순환하는 코드가 있습니다. 첨부 파일을 추가하고 전자 메일을 보내는 코드는 일반적으로 아래 코드가 어떻게 설정되었는지에 따라 전자 메일 목록의 마지막 사람이 두 번 전자 메일로 전송됩니다. DB가 보내는 첫 번째 사람과 마지막 사람입니다. 이메일을 보내 주시면 ...MS Access While 루프 첫 번째 레코드 건너 뛰기

본인은 관련 코드를 아래에 포함 시켰습니다. 늘 그렇듯이 제공 할 수있는 도움에 대해 크게 감사드립니다.

Private Sub SchedEmailButton_Click() 

    Me.FacEmailingList2.SetFocus 
    RunCommand acCmdRecordsGoToLast 'I've tried moving this and the next line of code to the "Sub Form_Current" (See below) but then the application just blinks and does nothing 
    RunCommand acCmdRecordsGoToFirst

또는, 나는 단지 첫 번째 레코드가 생략됩니다 때 (따라서 내 게시물 제목) 인 버튼뿐만 아니라이 시도했습니다

Private Sub SchedEmailButton_Click() 

    Dim rst As DAO.Recordset 

    Me.FacEmailingList2.SetFocus 
     While Not rst.EOF 
     rst.MoveNext 
     Wend 
     Set rst = Nothing

이를 통해 루프 코드입니다 이메일 수신자 목록 (편집) 벗었 정말 어떤 중요한 인해 길이 :

Private Sub Form_Current() 

[Set Variables] 

     'RunCommand acCmdRecordsGoToLast 'This causes the email automation code to fail 
     'RunCommand acCmdRecordsGoToFirst 
     While Me.CurrentRecord <= Me.Recordset.RecordCount 
[Working Loop Code Area] 
     Wend

[편집]이 (단지 경우) 전체 코드입니다 :

Private Sub Form_Current() 

Dim db As DAO.Database 
Dim rs As DAO.Recordset 
Dim rsFiltered As DAO.Recordset 
Dim WhereSem As String 
Dim WhereYear As String 
Dim WhereFac As String 
Dim WSemq As String 
Dim WYearq As String 
Dim WFacq As String 
Dim objOutlook As Object 
Dim objOutlookMsg As Object 
Dim objOutlookRecip As Object 
Dim objOutlookAttach As Object 
Dim docuser As String 
Dim docpath1 As String 
Dim docpath2 As String 
Dim docname As String 
Dim docaddpath As String 
Dim fulldoc As String 
Dim syllabifile As String 
Dim syllabidoc As String 
Dim syllabidocx As String 
Dim syllabipdf As String 
Dim syllabiloc As String 
Dim ABETfile As String 
Dim ABETOf As String 
Dim ABETOdoc As String 
Dim ABETOdocx As String 
Dim ABETOpdf As String 
Dim ABETOloc As String 
Dim ABETQf As String 
Dim ABETQdoc As String 
Dim ABETQdocx As String 
Dim ABETQpdf As String 
Dim ABETQtemp As String 
Dim ABETQinst As String 
Dim ABETQloc As String 
Dim sqlstr As String 
Dim abatt As Integer 

abatt = 0  

     'RunCommand acCmdRecordsGoToLast 'This causes the email automation code to fail 
     'RunCommand acCmdRecordsGoToFirst 
     While Me.CurrentRecord <= Me.Recordset.RecordCount 

      WhereSem = "[Semester_ID]= " & CLng(Forms![MenMain3]![NavigationSubform].Form![Semester]) 
      WhereYear = "[Year_ID]= " & CLng(Forms![MenMain3]![NavigationSubform].Form![YearSelect]) 
      WhereFac = "[Fac_ID]= " & CLng(Forms![MenMain3]![NavigationSubform].Form![FacEmailID]) 

      'Close report in case it's open 
      DoCmd.Close acReport, "ScheduleEmail", acSaveYes 

      'Open report 
      DoCmd.OpenReport "ScheduleEmail", acViewReport, , WhereSem & " And " & WhereYear & " And " & WhereFac 

      docuser = Environ$("USERPROFILE") 
      docaddpath = Left(Reports!ScheduleEmail![Semester], 2) & Reports!ScheduleEmail![SemesterYear] & "\" 
      docpath1 = docuser & "\documents\DB\Docs\" 
      docpath2 = docpath1 & docaddpath 
      docname = Reports!ScheduleEmail![Emp_Last] & Reports!ScheduleEmail![Emp_First] 
      fulldoc = docpath2 & docname & ".pdf" 

      If Dir(docpath1, vbDirectory) = "" Then 
       MkDir (docpath1) 
      End If 

      If Dir(docpath2, vbDirectory) = "" Then 
       MkDir (docpath2) 
      End If 

      DoCmd.OutputTo acOutputReport, , acFormatPDF, fulldoc, False 

      ' Create the Outlook session. 
      Set objOutlook = CreateObject("Outlook.Application") 

      ' Create the message. 
      Set objOutlookMsg = objOutlook.CreateItem(0) 


      With objOutlookMsg 
       ' Add the To recipient(s) to the message. 
       .To = Me.Email 

       ' Set the Subject, Body, and Importance of the message. 
       .Subject = Me.emailsubject 
       .Body = Me.EmailText 

       ' Add attachments to the message. 
       If Not IsMissing(AttachmentPath) Then 
        .Attachments.Add (fulldoc) 

        'Send the Syllabi for the class 
        Set db = CurrentDb() 

        WSemq = "Semester_ID =" & CLng(Forms![MenMain3]![NavigationSubform].Form![Semester]) 

        WYearq = "Year_ID =" & CLng(Forms![MenMain3]![NavigationSubform].Form![YearSelect]) 

        WFacq = "Fac_ID =" & CLng(Forms![MenMain3]![NavigationSubform].Form![FacEmailID]) 

        Set rs = db.OpenRecordset("Select * FROM RE_SchedCourse_EmailAttachment2_Q WHERE " & WSemq & " And " & WYearq & " And " & WFacq, dbOpenDynaset) 

        If rs.RecordCount <> 0 Then 
         rs.MoveLast 
         rs.MoveFirst 
        End If 

        Do While Not rs.EOF 

         If IsNull(rs!Fac_ID) Then 
          Exit Do 
         End If 

         syllabifile = rs!Prefix & rs!Prefix_Num & " Syllabus" 
         syllabiloc = "S:\Latest Syllabi\" 
         syllabidoc = syllabifile & ".doc" 
         syllabidocx = syllabifile & ".docx" 
         syllabipdf = syllabifile & ".pdf" 

         If FileExists(syllabiloc & syllabidoc) Then 
          .Attachments.Add (syllabiloc & syllabidoc) 
         ElseIf FileExists(syllabiloc & syllabidocx) Then 
          .Attachments.Add (syllabiloc & syllabidocx) 
         ElseIf FileExists(syllabiloc & syllabipdf) Then 
          .Attachments.Add (syllabiloc & syllabipdf) 
         End If 

         'Set the ABETfile names 
         ABETfile = rs!Prefix & " " & rs!Prefix_Num '& " " & rs!Course_Name 

         'Set the ABET Outcomes files 
         ABETOf = ABETfile & " ABET Outcomes" 
         ABETOloc = "S:\ABET Outcomes\" 
         ABETOdoc = ABETOf & ".doc" 
         ABETOdocx = ABETOf & ".docx" 
         ABETOpdf = ABETOf & ".pdf" 

         'If there are ABET Outcomes send those 
         If FileExists(ABETOloc & ABETOdoc) Then 
          .Attachments.Add (ABETOloc & ABETOdoc) 
          abatt = abatt + 1 
         ElseIf FileExists(ABETOloc & ABETOdocx) Then 
          .Attachments.Add (ABETOloc & ABETOdocx) 
          abatt = abatt + 1 
         ElseIf FileExists(ABETOloc & ABETOpdf) Then 
          .Attachments.Add (ABETOloc & ABETOpdf) 
          abatt = abatt + 1 
         End If 

         'Set the ABET Quizzes files 
         ABETQf = ABETfile & " ABET Quizzes" 
         ABETQloc = "S:\ABET Quizzes\" 
         ABETQtemp = "ABET Data Fall TEMPLATE.xlsx" 
         ABETQinst = "ABET TESTS (instructions).docx" 
         ABETQdoc = ABETQf & ".doc" 
         ABETQdocx = ABETQf & ".docx" 
         ABETQpdf = ABETQf & ".pdf" 

         'If there are ABET Quizzes send those 
         If FileExists(ABETQloc & ABETQdoc) Then 
          .Attachments.Add (ABETQloc & ABETQdoc) 
          abatt = abatt + 1 
         ElseIf FileExists(ABETQloc & ABETQdocx) Then 
          .Attachments.Add (ABETQloc & ABETQdocx) 
          abatt = abatt + 1 
         ElseIf FileExists(ABETQloc & ABETQpdf) Then 
          .Attachments.Add (ABETQloc & ABETQpdf) 
          abatt = abatt + 1 
         End If 

         If rs.RecordCount <> 0 Then 
          rs.MoveNext 
         End If 
        Loop 

        'Attach extra ABET Quiz documents 
        If abatt >= 1 Then 
         Set objOutlookAttach = .Attachments.Add(ABETQloc & ABETQtemp) 
         Set objOutlookAttach = .Attachments.Add(ABETQloc & ABETQinst) 
         abatt = 0 
        End If 

        rs.Close 

        Set rs = Nothing 

       End If 

       ' Resolve each Recipient's name. 
       For Each objOutlookRecip In .Recipients 
        objOutlookRecip.Resolve 
       Next 

       ' Should we display the message before sending? 
       If DisplayMsg Then 
        .Display 
       Else 
        .Save 
        .Send 
       End If 
      End With 

      Set objOutlook = Nothing 

      DoCmd.Close acReport, "ScheduleEmail", acSaveYes 

      If Me.CurrentRecord <= Me.Recordset.RecordCount Then 

       DoCmd.GoToRecord record:=acNext 
      Else: DoCmd.GoToRecord record:=acFirst 
      End If 
     Wend

[편집]

여기에 버튼 코드가 지금의 모습입니다. 나는 하위 폼의 모든 것을 참조하고있어 참조가 어떻게 만들어 지는지에 엉망이 될 것 때문에 :

Private Sub SchedEmailButton_Click() 

Dim rst As DAO.Recordset 

Set rst = Me.FacEmailingList2.Form.Recordset 

Me.FacEmailingList2.SetFocus 
RunCommand acCmdRecordsGoToLast 
RunCommand acCmdRecordsGoToFirst 

While Not rst.EOF 'CurentRecord <= RecordCount 

    SchedEmail 
    'RunCommand acCmdRecordsGoToNext 
    DoCmd.GoToRecord record:=acNext 

    If rst.EOF Then 'CurrentRecord <= Recordset.RecordCount Then 

     DoCmd.GoToRecord record:=acNext 
    Else: DoCmd.GoToRecord record:=acFirst 
    End If 
Wend

가 여기에 이메일 루프에 만들어 놓은 기본적인 변화이다 (나는 그것의 자신의 방법이를했습니다 무엇보다 참고할 수 있습니다.) :

Sub SchedEmail() 

Dim db As DAO.Database 
Dim rs As DAO.Recordset 
Dim rsFiltered As DAO.Recordset 
Dim WhereSem As String 
Dim WhereYear As String 
Dim WhereFac As String 
Dim WSemq As String 
Dim WYearq As String 
Dim WFacq As String 
Dim objOutlook As Object 
Dim objOutlookMsg As Object 
Dim objOutlookRecip As Object 
Dim objOutlookAttach As Object 
Dim docuser As String 
Dim docpath1 As String 
Dim docpath2 As String 
Dim docname As String 
Dim docaddpath As String 
Dim fulldoc As String 
Dim syllabifile As String 
Dim syllabidoc As String 
Dim syllabidocx As String 
Dim syllabipdf As String 
Dim syllabiloc As String 
Dim ABETfile As String 
Dim ABETOf As String 
Dim ABETOdoc As String 
Dim ABETOdocx As String 
Dim ABETOpdf As String 
Dim ABETOloc As String 
Dim ABETQf As String 
Dim ABETQdoc As String 
Dim ABETQdocx As String 
Dim ABETQpdf As String 
Dim ABETQtemp As String 
Dim ABETQinst As String 
Dim ABETQloc As String 
Dim sqlstr As String 
Dim abatt As Integer 

abatt = 0  

     'RunCommand acCmdRecordsGoToLast 'This causes the email automation code to fail 
     'RunCommand acCmdRecordsGoToFirst 
     While Me.CurrentRecord <= Me.Recordset.RecordCount 

      WhereSem = "[Semester_ID]= " & CLng(Forms![MenMain3]![NavigationSubform].Form![Semester]) 
      WhereYear = "[Year_ID]= " & CLng(Forms![MenMain3]![NavigationSubform].Form![YearSelect]) 
      WhereFac = "[Fac_ID]= " & CLng(Forms![MenMain3]![NavigationSubform].Form![FacEmailID]) 

      'Close report in case it's open 
      DoCmd.Close acReport, "ScheduleEmail", acSaveYes 

      'Open report 
      DoCmd.OpenReport "ScheduleEmail", acViewReport, , WhereSem & " And " & WhereYear & " And " & WhereFac 

      docuser = Environ$("USERPROFILE") 
      docaddpath = Left(Reports!ScheduleEmail![Semester], 2) & Reports!ScheduleEmail![SemesterYear] & "\" 
      docpath1 = docuser & "\documents\DB\Docs\" 
      docpath2 = docpath1 & docaddpath 
      docname = Reports!ScheduleEmail![Emp_Last] & Reports!ScheduleEmail![Emp_First] 
      fulldoc = docpath2 & docname & ".pdf" 

      If Dir(docpath1, vbDirectory) = "" Then 
       MkDir (docpath1) 
      End If 

      If Dir(docpath2, vbDirectory) = "" Then 
       MkDir (docpath2) 
      End If 

      DoCmd.OutputTo acOutputReport, , acFormatPDF, fulldoc, False 

      ' Create the Outlook session. 
      Set objOutlook = CreateObject("Outlook.Application") 

      ' Create the message. 
      Set objOutlookMsg = objOutlook.CreateItem(0) 


      With objOutlookMsg 
       ' Add the To recipient(s) to the message. 
       .To = Me.Email 

       ' Set the Subject, Body, and Importance of the message. 
       .Subject = Me.emailsubject 
       .Body = Me.EmailText 

       ' Add attachments to the message. 
       If Not IsMissing(AttachmentPath) Then 
        .Attachments.Add (fulldoc) 

        'Send the Syllabi for the class 
        Set db = CurrentDb() 

        WSemq = "Semester_ID =" & CLng(Forms![MenMain3]![NavigationSubform].Form![Semester]) 

        WYearq = "Year_ID =" & CLng(Forms![MenMain3]![NavigationSubform].Form![YearSelect]) 

        WFacq = "Fac_ID =" & CLng(Forms![MenMain3]![NavigationSubform].Form![FacEmailID]) 

        Set rs = db.OpenRecordset("Select * FROM RE_SchedCourse_EmailAttachment2_Q WHERE " & WSemq & " And " & WYearq & " And " & WFacq, dbOpenDynaset) 

        If rs.RecordCount <> 0 Then 
         rs.MoveLast 
         rs.MoveFirst 
        End If 

        Do While Not rs.EOF 

         If IsNull(rs!Fac_ID) Then 
          Exit Do 
         End If 

         syllabifile = rs!Prefix & rs!Prefix_Num & " Syllabus" 
         syllabiloc = "S:\Latest Syllabi\" 
         syllabidoc = syllabifile & ".doc" 
         syllabidocx = syllabifile & ".docx" 
         syllabipdf = syllabifile & ".pdf" 

         If FileExists(syllabiloc & syllabidoc) Then 
          .Attachments.Add (syllabiloc & syllabidoc) 
         ElseIf FileExists(syllabiloc & syllabidocx) Then 
          .Attachments.Add (syllabiloc & syllabidocx) 
         ElseIf FileExists(syllabiloc & syllabipdf) Then 
          .Attachments.Add (syllabiloc & syllabipdf) 
         End If 

         'Set the ABETfile names 
         ABETfile = rs!Prefix & " " & rs!Prefix_Num '& " " & rs!Course_Name 

         'Set the ABET Outcomes files 
         ABETOf = ABETfile & " ABET Outcomes" 
         ABETOloc = "S:\ABET Outcomes\" 
         ABETOdoc = ABETOf & ".doc" 
         ABETOdocx = ABETOf & ".docx" 
         ABETOpdf = ABETOf & ".pdf" 

         'If there are ABET Outcomes send those 
         If FileExists(ABETOloc & ABETOdoc) Then 
          .Attachments.Add (ABETOloc & ABETOdoc) 
          abatt = abatt + 1 
         ElseIf FileExists(ABETOloc & ABETOdocx) Then 
          .Attachments.Add (ABETOloc & ABETOdocx) 
          abatt = abatt + 1 
         ElseIf FileExists(ABETOloc & ABETOpdf) Then 
          .Attachments.Add (ABETOloc & ABETOpdf) 
          abatt = abatt + 1 
         End If 

         'Set the ABET Quizzes files 
         ABETQf = ABETfile & " ABET Quizzes" 
         ABETQloc = "S:\ABET Quizzes\" 
         ABETQtemp = "ABET Data Fall TEMPLATE.xlsx" 
         ABETQinst = "ABET TESTS (instructions).docx" 
         ABETQdoc = ABETQf & ".doc" 
         ABETQdocx = ABETQf & ".docx" 
         ABETQpdf = ABETQf & ".pdf" 

         'If there are ABET Quizzes send those 
         If FileExists(ABETQloc & ABETQdoc) Then 
          .Attachments.Add (ABETQloc & ABETQdoc) 
          abatt = abatt + 1 
         ElseIf FileExists(ABETQloc & ABETQdocx) Then 
          .Attachments.Add (ABETQloc & ABETQdocx) 
          abatt = abatt + 1 
         ElseIf FileExists(ABETQloc & ABETQpdf) Then 
          .Attachments.Add (ABETQloc & ABETQpdf) 
          abatt = abatt + 1 
         End If 

         If rs.RecordCount <> 0 Then 
          rs.MoveNext 
         End If 
        Loop 

        'Attach extra ABET Quiz documents 
        If abatt >= 1 Then 
         Set objOutlookAttach = .Attachments.Add(ABETQloc & ABETQtemp) 
         Set objOutlookAttach = .Attachments.Add(ABETQloc & ABETQinst) 
         abatt = 0 
        End If 

        rs.Close 

        Set rs = Nothing 

       End If 

       ' Resolve each Recipient's name. 
       For Each objOutlookRecip In .Recipients 
        objOutlookRecip.Resolve 
       Next 

       ' Should we display the message before sending? 
       If DisplayMsg Then 
        .Display 
       Else 
        .Save 
        .Send 
       End If 
      End With 

      Set objOutlook = Nothing 

      DoCmd.Close acReport, "ScheduleEmail", acSaveYes 

      If Me.CurrentRecord <= Me.Recordset.RecordCount Then 

       DoCmd.GoToRecord record:=acNext 
      Else: DoCmd.GoToRecord record:=acFirst 
      End If

출처

2014-12-29 Vaulcul

이렇게 많은 코드를 처리 할 수 있습니다. 샘플로 여기에 게시 할 수있는 몇 줄로 문제를 줄일 수 있습니까? 그렇게하면 문제가 발생할 가능성이 큽니다. –

나는 그것을 두려워했다. (너무 많은 코드를 통해 파헤쳐 보았다 ...) 나는 여기에 너무 많은 정보의 측면에서 잘못을 범했다. 이 문제의 경우 하단 루프 코드가 일반적인 참조 용으로 만 존재합니다. 메인 루프가 정상적으로 실행되고, 올바르게 시작되지 않습니다 ... 불필요한 코드를 자릅니다. – Vaulcul

루프를보고 있는데, MoveNext를 반복해서 호출하는 것처럼 보입니다. 나머지 코드 배치는 중요 할 수 있습니다. 'rst'가 첫 번째 레코드에서 시작하고'MoveNext'가 루프 내에서 처음으로 발생하면, 처리되기 전에 첫 번째 결과를 건너 뜁니다. 'MoveNext'는 시작 대신에 루프의 끝으로 가야합니다. 나는 처음부터 어디서부터 시작해야할지 모르겠다. 왜냐하면 나는 어떤 종류의 정기적 인 기초 위에서 VBA와 일하지 않기 때문에, 그러나 그것은 꽤 흔한 실수 일 것이다. 나는 상상한다.그 줄에있는 어떤 것이 가장 가능성있는 원인처럼 보입니다. – jpmc26

나는 마침내 작동하게되었습니다!

"Current"이벤트의 하위 폼에서 "Click"이벤트로 코드를 옮기는 제안은 매우 도움이되었고 올바른 방향으로 나를 잡았습니다.

나는 다음 레코드로 갈 수있는 루프를 얻는 방법에 문제가 조금 있었다, 그러나 이것은 내가 좀 더 검색 한 후 함께 결국 무엇을 :

는

Private Sub SchedEmailButton_Click() 

Dim rst As Object 'DAO.Recordset <-- For some reason unknown to me the code didn't like declaring as a "DAO.Recordset" 

Set rst = Me.FacEmailingList2.Form.Recordset 

With rst 
      .MoveFirst 
      Do While Not .EOF 
       SchedEmail 
       .MoveNext 
      Loop 
     End With 
     Set rst = Nothing

이 작동하지 않았다 다음 레코드로 이동하십시오 (이유를 모르겠습니다).

RunCommand acCmdRecordsGoToNext 
DoCmd.GoToRecord record:=acNext 
DoCmd.GoToRecord , , acNext

출처

2014-12-30 18:50:35 Vaulcul

먼저 "Set rst = Me.RecordsetClone"또는 "Set rst = Me.FacEmailingList2.Form.RecordsetClone"중 하나를 사용해야한다고 생각합니다. 둘째, 대안이 없으면 항상 명시 적으로 객체를 입력하는 것이 가장 좋습니다 (때로는 객체를 사용하여 이상한 결과를 얻을 수 있습니다. 그냥 '객체'). 따라서 나는 다음과 같이 제안한다 : "DAO.Recordset로서의 첫 번째 모순" –

Wayne, 나는 돌아가서 당신이 제안한 변경을 재 시도했다. 개체 유형을 "DAO.Recordset"에 아무 문제없이 설정할 수있었습니다 ... 그러나 "Me.FacEmailingList2.Form.Recordset"에서 "Me.FacEmailingList2.Form.RecordsetClone"으로 변경하려고하면 루프가 실행됩니다. 다시 이메일을 보내는 동안 첫 번째 기록에 머물러있게됩니다. – Vaulcul

Yikes! 서브 루틴 'SchedEmail'에 대해 아무 것도 했니? 거기에서 당신은 당신의 레코드 세트에서 돌아 다니고 있습니다. 레코드 세트를 사용하는 장소는 하나만 있어야합니다. –

MS Access While 루프 첫 번째 레코드 건너 뛰기

답변

관련 문제