Playing with Emails! (1 Viewer)

Private Sub btnEnter_Click()
        If (DCount("*", "qryDuplicateRequest") = 0) Then
            DoCmd.GoToRecord acForm, "frmRequest", acNewRec
        End If
    DoCmd.Close acQuery, "qryDuplicateRequest"
    Me.Refresh
    Me.txtemail.Requery

        Dim varName As Variant
        Dim varCC As Variant
        Dim varSubject As Variant
        Dim varBody As Variant

            [B][U]varName = Me.txtemail.Value[/U][/B]
            varCC = "NFCCYCLECOUNTERS@unicarriersamericas.com, NFCPARTSHORTAGE@unicarriersamericas.com"
            varSubject = "IVR Request has been submitted."
            varBody = "Thank you for your request, your part has been added to the list."
        DoCmd.SendObject , , , varName, varCC, , varSubject, varBody, True, False

Private Sub btnEnter_Click()
        If (DCount("*", "qryDuplicateRequest") = 0) Then
            DoCmd.GoToRecord acForm, "frmRequest", acNewRec
        End If
    DoCmd.Close acQuery, "qryDuplicateRequest"
    Me.Refresh
    Me.txtemail.Requery

        Dim varName As Variant
        Dim varCC As Variant
        Dim varSubject As Variant
        Dim varBody As Variant

            varName = Me.txtemail.Value

            [COLOR="Red"]msgbox "EMail address is " & varName[/COLOR]

            varCC = "NFCCYCLECOUNTERS@unicarriersamericas.com, NFCPARTSHORTAGE@unicarriersamericas.com"
            varSubject = "IVR Request has been submitted."
            varBody = "Thank you for your request, your part has been added to the list."
        DoCmd.SendObject , , , varName, varCC, , varSubject, varBody, True, False

Option Compare Database
'-------------------------------------------------------------------------
Private Sub Btn_Attachment_Click()
    'Use fileDialog to allow user to select an attachment to send.
    'Use Me.Lbl_Attachment.Caption to show file attached.
    
    Dim aoFileDialog As Office.FileDialog
    Dim varFile As Variant
    
    Me.Lbl_Attachment.Caption = ""
    
    Set aoFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    With aoFileDialog
       .TITLE = "Select Attachment"
       .AllowMultiSelect = False
       .Filters.Clear
       If .Show = True Then
          Me.Lbl_Attachment.Caption = .SelectedItems(1)
       End If
    End With
End Sub
'-------------------------------------------------------------------------
Private Sub CboRecipients_AfterUpdate()
    'Allow user to select class from drop down. Put ID (2nd column) on screen
    'so when they complain its not working I can find out why.
    Me.L_ClassID.Caption = Me.CboRecipients.Column(1)
End Sub
'-------------------------------------------------------------------------
Private Sub Cmd_Send_Click()
   Dim asSQL As String
   Dim rs As DAO.Recordset
   Dim afError As Byte
   Dim asError As String
      
   afError = False
   asError = ""
   If Me.L_ClassID.Caption = "Class ID" Then ' If no class selected
      asError = " No class selected"
      afError = True
   End If
   If Nz(Me.TxtSubject, "") = "" Then ' Or no subject entered
      asError = asError & " No Subject"
      afError = True
   End If
   If Nz(Me.TxtMessage, "") = "" Then ' Or no message entered
      asError = asError & " No Message"
      afError = True
   End If
   
   If afError = True Then ' If we can't send an Email, complain and leave.
      MsgBox asError & Chr(13) & Chr(10) & "Cannot send Email yet"
      Exit Sub
   End If
   
   'Begin going through the students by class, matching selected class.
   asSQL = "SELECT T_Nursing.Email FROM T_Nursing WHERE T_Nursing.Class = " & Me.L_ClassID.Caption
   'MsgBox "SQL is " & asSQL
   Set rs = CurrentDb.OpenRecordset(asSQL)
   
   'Check to see if the recordset actually contains rows
   If Not (rs.EOF And rs.BOF) Then
       rs.MoveFirst 'Unnecessary in this case, but still a good habit
       Do Until rs.EOF = True
          Send_Email (rs("EMail")) 'Use the EMail field in the record set to send.
          'Move to the next record. Don't ever forget to do this.
          rs.MoveNext
       Loop
   Else
       MsgBox "There are no records in the recordset."
   End If

   'MsgBox "Finished looping through records."

   rs.Close 'Close the recordset
   Set rs = Nothing 'Clean up
End Sub
'-------------------------------------------------------------------------
Private Sub Send_Email(pvMailAddress As Variant)

    Dim EmailApp As Outlook.Application
    Dim NameSpace As Outlook.NameSpace
    Dim Folder As Outlook.Folder
    Dim EmailSend As Outlook.MailItem
          
    'MsgBox "Sending EMail to " & pvMailAddress
        
    'create email
    Set EmailApp = New Outlook.Application
    Set NameSpace = EmailApp.GetNamespace("MAPI")
    Set Folder = NameSpace.GetDefaultFolder(olFolderInbox)
    Set EmailSend = Folder.Items.Add(olMailItem)
    
    With EmailSend
        .To = pvMailAddress
        .Subject = Me.TxtSubject
        .HTMLBody = Me.TxtMessage
        .ReadReceiptRequested = False
        If Not IsNull(Dt_Send) Then
           .DeferredDeliveryTime = Me.Dt_Send
        End If
        If Me.Lbl_Attachment.Caption <> "" Then
           .Attachments.Add (Me.Lbl_Attachment.Caption)
        End If
        .Display
        '.Send
    End With
    
End Sub