Auto Email

drubin25

Board Regular
Joined
Mar 19, 2016
Messages
62
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.

VBA Code:
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
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,577
The following works here :

VBA Code:
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

Board Regular
Joined
Mar 19, 2016
Messages
62
@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

VBA Code:
[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]
 

Forum statistics

Threads
1,182,203
Messages
5,934,251
Members
436,938
Latest member
Mthalaj

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top