Auto Email

[drubin25]

I am trying to automatically send an email when a certain condition is met. I am close, but can't figure out what I am missing. Everything works fine, until the time I call Email

Below is the code to send the email.

Sub Email()

  Dim OutlookApp As Object
  Dim OutlookMail As Object

  Set OutlookApp = CreateObject("Outlook.Application")
  Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail
    .To = "dmrubin25@gmail.com"
    .CC = "dmrubin25@gmail.com"
    .BCC = "dmrubin25@gmail.com"
    .Subject = "ACTION REQUIRED: ENTER A BACKORDER" & CS.Range("G4").Value & "PO Number " & CS.Range("G20")
    .BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "Please create a backorder for the following:" & vbNewLine & vbNewLine & "Customer: " & CS.Range("G4").Value & vbNewLine & _
        "Customer #: " & CS.Range("M4").Value & vbNewLine & "Quantity: " & CS.Range("R8").Value & vbNewLine & "PO Number: " & CS.Range("G20").Value & _
        vbNewLine & vbNewLine & "Contact for Questions: " & CS.Range("M14").Value
        .Importance = 2
        .Send
End With

SetoutlookMail = Nothing
Set OutlookApp = Nothing

End Sub

 

[Logit]

The following works here :

Option Explicit

Sub Email()

  Dim OutlookApp As Object
  Dim OutlookMail As Object

  Set OutlookApp = CreateObject("Outlook.Application")
  Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail
    .To = "dmrubin25@gmail.com"
    .CC = "dmrubin25@gmail.com"
    .BCC = "dmrubin25@gmail.com"
    .Subject = "ACTION REQUIRED: ENTER A BACKORDER" & ActiveSheet.Range("G4").Value & "PO Number " & ActiveSheet.Range("G20")
    '.BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "Please create a backorder for the following:" & vbNewLine & vbNewLine & "Customer: " & ActiveSheet.Range("G4").Value & vbNewLine & _
        "Customer #: " & ActiveSheet.Range("M4").Value & vbNewLine & "Quantity: " & ActiveSheet.Range("R8").Value & vbNewLine & "PO Number: " & ActiveSheet.Range("G20").Value & _
        vbNewLine & vbNewLine & "Contact for Questions: " & ActiveSheet.Range("M14").Value
        .Importance = 2
        '.Send
        .Display
End With

Set OutlookMail = Nothing
Set OutlookApp = Nothing

End Sub

 

[drubin25]

@Logit this didnt work for some reason. Let me expand a bit. If cell D26 ="SEND TO OFFICE TO CREATE A BACKORDER.", then I want it to save the record and then send an email (not an attachement, just an email). I've added the code (in blue) for cell D26 on. Thank you again.

If cell

[COLOR=rgb(44, 130, 201)] If CS.Range("D26").Value = "SEND TO OFFICE TO CREATE A BACKORDER." Then
'
        Call Email                                                                                                  
'
        lr = PS.Range("A" & PS.Rows.Count).End(xlUp).Row + 1            ' Find First Empty Row after Data
'
'
    End If
'
    lr = PS.Cells(Rows.Count, 1).End(xlUp).Row + 1                  ' Find First Empty Row after Data
'
'   Copy data from the INPUT to the RECORDS worksheet
    ArSourceAddress = Array("M4", "G4", "D17", "G14", "G7", "M7", "P7", "G11", "D26", "M14")
'
    For I = 0 To UBound(ArSourceAddress)
        PS.Cells(lr, I + 1).Value = CS.Range(ArSourceAddress(I)).Value           ' Columns 1 thru 10 .... Array addresses
    Next
'
    PS.Cells(lr, 11).Resize(, 4).Value = CS.Range("S24").Resize(, 4).Value  'Columns 11,12,13,14 .... S24,T24,U24,V24
'
    PS.Cells(lr, 15).Resize(, 2).Value = CS.Range("X24").Resize(, 2).Value  ' Columns 15,16 .... X24,Y24
'
    MsgBox "THE RECORD HAS BEEN SAVED." & vbCrLf & " " & vbCrLf & "XXXXXXX."

''Application.ScreenUpdating = True
End Sub[/COLOR]

[COLOR=rgb(251, 160, 38)]Sub Email()

  Dim OutlookApp As Object
  Dim OutlookMail As Object

  Set OutlookApp = CreateObject("Outlook.Application")
  Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail
    .To = "drubin@jeldwen.com"
    .CC = "drubin@jeldwen.com"
    .BCC = "drubin@jeldwen.com"
    .Subject = "ACTION REQUIRED: ENTER A BACKORDER" & CS.Range("G4").Value & "PO Number " & CS.Range("G20")
    .BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "Please create a backorder for the following:" & vbNewLine & vbNewLine & "Customer: " & CS.Range("G4").Value & vbNewLine & _
        "Customer #: " & CS.Range("M4").Value & vbNewLine & "Quantity: " & CS.Range("R8").Value & vbNewLine & "PO Number: " & CS.Range("G20").Value & _
        vbNewLine & vbNewLine & "Contact for Questions: " & CS.Range("M14").Value
        .Importance = 2
        .Send
End With

SetoutlookMail = Nothing
Set OutlookApp = Nothing

End Sub[/COLOR]