Case Select help

oxicottin

Learning by pecking away....
Local time
Today, 17:52
Joined
Jun 26, 2007
Messages
889
Case Select email function

Hello, I need to use case select to send out an email with some data from my form. I have used the code below sucessufully without the case select. I added the cases and I know im missing "End IF" ect I just dont know where and what else. Can someone look it over and see what I have missed? I debug and it takes me to the end function:
Code:
If Me.txtDateOfReport = "" Or IsNull(Me.txtDateOfReport) Then
                   Me.cboEmployeeName.SetFocus
                    End Function
and says "Block If without end if".....

Here is what I got so far:
Code:
Private Function EmailData()

'//Function to email some data on the form using outlook
  'Uses the table tblEmailAddress to retrieve the email address to send
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sEmailList As String
    Dim stSubject As String
    Dim stText As String
    Dim DateOfRep As Variant
    Dim stBody1 As String
    Dim stBody2 As String
    Dim stBody3 As String
    Dim stAccidentType As String
    Dim stLocation As String
    
    
    With Forms!frmActConditionSafety

        Select Case optClassicficationGroup.Value

            Case 1, 2
            
                  If Me.txtDateOfReport = "" Or IsNull(Me.txtDateOfReport) Then
                   Me.cboEmployeeName.SetFocus
                    End Function
                     End If
                  If Me.txtLocationOfAccident = "" Or IsNull(Me.txtLocationOfAccident) Then
                   Me.txtLocationOfAccident.SetFocus
                    End Function
                      End If
                  If Me.txtDescribeAccident = "" Or IsNull(Me.txtDescribeAccident) Then
                   Me.txtDescribeAccident.SetFocus
                    End Function
                      End If
                  If Me.txtCorrectiveAction = "" Or IsNull(Me.txtCorrectiveAction) Then
                   Me.txtCorrectiveAction.SetFocus
                    End Function
                
                       Else
                       
                  stSubject = "New " & Me.txtClassificationTypeName
                  DateOfRep = Me.txtDateOfReport
                  stBody1 = Me.txtDescribeAccident
                  stBody2 = Me.txtCorrectiveAction
                  stAccidentType = Me.txtClassificationTypeName
                  stLocation = Me.txtLocationOfAccident
                  
                  stText = "A new Safety Observation Entry has been created." & Chr$(13) & _
                           "Please review with your team members." & Chr$(13) & Chr$(13) & _
                           "Accident Type:  " & stAccidentType & Chr$(13) & Chr$(13) & _
                           "Date Of Report: " & DateOfRep & Chr$(13) & Chr$(13) & _
                           "Location: " & stLocation & Chr$(13) & Chr$(13) & _
                           "Description Of Incident: " & stBody1 & Chr$(13) & Chr$(13) & _
                           "Corrective Action: " & stBody2
                  
                  Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT strEMail " & _
                 "FROM tblEmailAddresses;")

    With rs
        If (Not .BOF) And (Not .EOF) Then
            .MoveFirst
            sEmailList = .Fields("strEMail")
            .MoveNext
        End If

        If (Not .BOF) And (Not .EOF) Then
            Do Until .EOF
                sEmailList = sEmailList & "; " & .Fields("strEMail")
                .MoveNext
            Loop
        End If

        .Close

    End With

    'Write the e-mail content for sending to assignee
    DoCmd.SendObject , , acFormatTXT, sEmailList, , , stSubject, stText, -1

    db.Close
    Set rs = Nothing
    Set db = Nothing
    
          Exit Function
          
            Case 3
            
                  If Me.txtDateOfReport = "" Or IsNull(Me.txtDateOfReport) Then
                   Me.cboEmployeeName.SetFocus
                    End Function
                     End If
                  If Me.txtSafetySuggestion = "" Or IsNull(Me.txtSafetySuggestion) Then
                   Me.txtDescribeAccident.SetFocus
                    End Function
                      End If
                       Else
                       
                  stSubject = "New " & Me.txtClassificationTypeName
                  DateOfRep = Me.txtDateOfReport
                  stBody3 = Me.txtSafetySuggestion
                  stAccidentType = Me.txtClassificationTypeName
                  
                  stText = "A new Safety Observation Entry has been created." & Chr$(13) & _
                           "Please review with your team members." & Chr$(13) & Chr$(13) & _
                           "Accident Type:  " & stAccidentType & Chr$(13) & Chr$(13) & _
                           "Date Of Report: " & DateOfRep & Chr$(13) & Chr$(13) & _
                           "Discription Of Suggestion: " & stBody3
                           
                  
                  Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT strEMail " & _
                 "FROM tblEmailAddresses;")

    With rs
        If (Not .BOF) And (Not .EOF) Then
            .MoveFirst
            sEmailList = .Fields("strEMail")
            .MoveNext
        End If

        If (Not .BOF) And (Not .EOF) Then
            Do Until .EOF
                sEmailList = sEmailList & "; " & .Fields("strEMail")
                .MoveNext
            Loop
        End If

        .Close

    End With

    'Write the e-mail content for sending to assignee
    DoCmd.SendObject , , acFormatTXT, sEmailList, , , stSubject, stText, -1

    db.Close
    Set rs = Nothing
    Set db = Nothing
    
          Exit Function
    
End Function
 
Last edited:
Two things missing (at least)

First you have this IF statement which has no closing END IF to it:
Code:
If Me.txtCorrectiveAction = "" Or IsNull(Me.txtCorrectiveAction) Then
Me.txtCorrectiveAction.SetFocus
End Function
 
Else
 
stSubject = "New " & Me.txtClassificationTypeName
DateOfRep = Me.txtDateOfReport
stBody1 = Me.txtDescribeAccident
stBody2 = Me.txtCorrectiveAction
stAccidentType = Me.txtClassificationTypeName
stLocation = Me.txtLocationOfAccident
....truncated for space

And then you also need your


End Select

down after the parts that go with Case 3 (wherever that may be).
 
Code:
Case 1, 2
            
                  If Me.txtDateOfReport = "" Or IsNull(Me.txtDateOfReport) Then
                   Me.cboEmployeeName.SetFocus
                    End Function
                     End If
                  If Me.txtLocationOfAccident = "" Or IsNull(Me.txtLocationOfAccident) Then
                   Me.txtLocationOfAccident.SetFocus
                    End Function
                      End If
                  If Me.txtDescribeAccident = "" Or IsNull(Me.txtDescribeAccident) Then
                   Me.txtDescribeAccident.SetFocus
                    End Function
                      End If
                  If Me.txtCorrectiveAction = "" Or IsNull(Me.txtCorrectiveAction) Then
                   Me.txtCorrectiveAction.SetFocus
 End Function
                [COLOR="red"][B]End If[/B][/COLOR]
                       Else

As far as I can tell, the issue is an unclosed If at the end of the Case 1,2 section.

EDIT: Sorry, didn't notice the post above. I expect he is more experienced than myself, so sorry about that.
 
I figured it out. I needed a "end select" at the bottom of the function and I was using end function instead of exit function.... and a few other little things. :p Thanks!


Code:
Private Function EmailData()

'//Function to email some data on the form using outlook
  'Uses the table tblEmailAddress to retrieve the email address to send
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sEmailList As String
    Dim stSubject As String
    Dim stText As String
    Dim DateOfRep As Variant
    Dim stBody1 As String
    Dim stBody2 As String
    Dim stBody3 As String
    Dim stAccidentType As String
    Dim stLocation As String
    
    
    With Forms!frmActConditionSafety

        Select Case optClassicficationGroup.Value

            Case 1, 2
            
                  If Me.txtDateOfReport = "" Or IsNull(Me.txtDateOfReport) Then
                   MsgBox "Please select a Report Date!", vbCritical, "Data Needed"
                   Me.txtDateOfReport.SetFocus
                    Exit Function
                     End If
                  If Me.txtLocationOfAccident = "" Or IsNull(Me.txtLocationOfAccident) Then
                   MsgBox "Please select a Location!", vbCritical, "Data Needed"
                   Me.txtLocationOfAccident.SetFocus
                    Exit Function
                      End If
                  If Me.txtDescribeAccident = "" Or IsNull(Me.txtDescribeAccident) Then
                   MsgBox "Please Describe the Incident!", vbCritical, "Data Needed"
                   Me.txtDescribeAccident.SetFocus
                    Exit Function
                      End If
                  If Me.txtCorrectiveAction = "" Or IsNull(Me.txtCorrectiveAction) Then
                   MsgBox "Please give a corrective action!", vbCritical, "Data Needed"
                   Me.txtCorrectiveAction.SetFocus
                    Exit Function
                    End If
                       
                  stSubject = "New " & Me.txtClassificationTypeName
                  DateOfRep = Me.txtDateOfReport
                  stBody1 = Me.txtDescribeAccident
                  stBody2 = Me.txtCorrectiveAction
                  stAccidentType = Me.txtClassificationTypeName
                  stLocation = Me.txtLocationOfAccident
                  
                  stText = "A new Safety Observation Entry has been created. Please review with your team members." & Chr$(13) & Chr$(13) & _
                           "Accident Type:  " & stAccidentType & Chr$(13) & _
                           "Date Of Report: " & DateOfRep & Chr$(13) & _
                           "Location: " & stLocation & Chr$(13) & Chr$(13) & _
                           "Description Of Incident: " & stBody1 & Chr$(13) & Chr$(13) & _
                           "Corrective Action: " & stBody2
                  
                  Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT strEMail " & _
                 "FROM tblEmailAddresses;")

    With rs
        If (Not .BOF) And (Not .EOF) Then
            .MoveFirst
            sEmailList = .Fields("strEMail")
            .MoveNext
        End If

        If (Not .BOF) And (Not .EOF) Then
            Do Until .EOF
                sEmailList = sEmailList & "; " & .Fields("strEMail")
                .MoveNext
            Loop
        End If

        .Close

    End With

    'Write the e-mail content for sending to assignee
    DoCmd.SendObject , , acFormatTXT, sEmailList, , , stSubject, stText, -1

    db.Close
    Set rs = Nothing
    Set db = Nothing
    
          Exit Function
          
            Case 3
            
                  If Me.txtDateOfReport = "" Or IsNull(Me.txtDateOfReport) Then
                   MsgBox "Please select a Report Date!", vbCritical, "Data Needed"
                   Me.txtDateOfReport.SetFocus
                    Exit Function
                     End If
                  If Me.txtSafetySuggestion = "" Or IsNull(Me.txtSafetySuggestion) Then
                   MsgBox "Please give a safety suggestion!", vbCritical, "Data Needed"
                   Me.txtSafetySuggestion.SetFocus
                    Exit Function
                      End If
                       
                  stSubject = "New " & Me.txtClassificationTypeName
                  DateOfRep = Me.txtDateOfReport
                  stBody3 = Me.txtSafetySuggestion
                  stAccidentType = Me.txtClassificationTypeName
                  
                  stText = "A new Safety Observation Entry has been created. Please review with your team members." & Chr$(13) & Chr$(13) & _
                           "Accident Type:  " & stAccidentType & Chr$(13) & _
                           "Date Of Report: " & DateOfRep & Chr$(13) & Chr$(13) & _
                           "Discription Of Suggestion: " & stBody3
                           
                  
                  Set db = CurrentDb()
    Set rs = db.OpenRecordset("SELECT strEMail " & _
                 "FROM tblEmailAddresses;")

    With rs
        If (Not .BOF) And (Not .EOF) Then
            .MoveFirst
            sEmailList = .Fields("strEMail")
            .MoveNext
        End If

        If (Not .BOF) And (Not .EOF) Then
            Do Until .EOF
                sEmailList = sEmailList & "; " & .Fields("strEMail")
                .MoveNext
            Loop
        End If

        .Close

    End With

    'Write the e-mail content for sending to assignee
    DoCmd.SendObject , , acFormatTXT, sEmailList, , , stSubject, stText, -1

    db.Close
    Set rs = Nothing
    Set db = Nothing
    
          Exit Function
        Case Else
    End Select
  End With
    
End Function
 

Users who are viewing this thread

Back
Top Bottom