I am trying to send an email if a condition is met, and it is not working.
If cell D26 on the "Input" tab = "SEND TO OFFICE TO CREATE A BACKORDER", I want to call email, then save the record. The record saving works, but it is not emailing. Thank you in advance!
If cell D26 on the "Input" tab = "SEND TO OFFICE TO CREATE A BACKORDER", I want to call email, then save the record. The record saving works, but it is not emailing. Thank you in advance!
VBA Code:
Sub SENDTOLOG_Click()
'
'' Application.ScreenUpdating = False
'
Dim CS As Worksheet, PS As Worksheet, lr As Long ' , M As Long
Dim LineQuantity As Long
Dim QtyRejected As Long
Dim TicketLoadDate As String
Dim ArSourceAddress() As Variant
Dim CustName As Variant
Dim POnumber As Variant
Dim RejectedBy As Variant
Dim SpecialBatchNumber As Variant
'
Set CS = Worksheets("Input")
Set PS = Worksheets("Records")
'
If CS.Range("G4") = "" Then
Do
CustName = Application.InputBox(Prompt:="Please enter the CUSTOMER NAME" & vbCrLf & " " & vbCrLf & "Por Favor, Introduzca el NOMBRE DEL CLIENTE") ' Text entry
Loop Until CustName <> vbNullString And CustName <> False
'
CS.Range("G4").Value = CustName
End If
'
If CS.Range("G7") = "" Then
Do
LineQuantity = Application.InputBox(Prompt:="Please enter the LINE QUANTITY" & vbCrLf & " " & vbCrLf & "Por Favor, introduzca la CANTIDAD DE LÍNEA", Type:=1) ' Numeric Entry
Loop Until LineQuantity <> 0 And LineQuantity <> False
'
CS.Range("G7").Value = LineQuantity
End If
'
If CS.Range("M7") = "" Then
Do
QtyRejected = Application.InputBox(Prompt:="Please enter the QTY REJECTED" & vbCrLf & " " & vbCrLf & "Por Favor, introduzca el QTY RECHAZADO ", Type:=1) ' Numeric Entry
Loop Until QtyRejected <> 0 And QtyRejected <> False
'
CS.Range("M7").Value = QtyRejected
End If
'
If CS.Range("G14") = "" Then
Do
TicketLoadDate = Application.InputBox(Prompt:="Please enter the TICKET LOAD DATE" & vbCrLf & " " & vbCrLf & "Por Favor, introduzca la FECHA DE CARGA DEL BILLETE") ' Date Entry
Loop Until IsDate(TicketLoadDate) = True
'
CS.Range("G14").Value = TicketLoadDate
End If
'
If CS.Range("M14") = "" Then
Do
RejectedBy = Application.InputBox(Prompt:="Please enter your name in the REJECTED BY: BOX" & vbCrLf & " " & vbCrLf & "Por Favor, introduzca su nombre en la CASILLA RECHAZADO POR") ' Text entry
Loop Until RejectedBy <> vbNullString And RejectedBy <> False
'
CS.Range("M14").Value = RejectedBy
End If
'
If CS.Range("G20") = "" Then
Do
POnumber = Application.InputBox(Prompt:="Please enter the PO NUMBER" & vbCrLf & " " & vbCrLf & "Por Favor, introduzca el Numero de Orden de Compra") ' Text entry
Loop Until POnumber <> vbNullString And POnumber <> False
'
CS.Range("G20").Value = POnumber
End If
'
If CS.Range("D26").Value = "CREATE SPECIAL BATCH" Then
MsgBox ("YOU MUST CREATE A SPECIAL BATCH" & vbCrLf & " " & vbCrLf & "DEBE CREAR UN LOTE ESPECIAL")
'
Do
SpecialBatchNumber = Application.InputBox(Prompt:="ENTER THE SPECIAL BATCH TICKET NUMBER THAT WAS CREATED: " & vbCrLf & "INTRODUZCA EL NÚMERO DE TICKET DE LOTE ESPECIAL QUE SE CREÓ:") ' Text entry
Loop Until SpecialBatchNumber <> vbNullString And SpecialBatchNumber <> False
'
lr = PS.Range("A" & PS.Rows.Count).End(xlUp).Row + 1 ' Find First Empty Row after Data
PS.Range("R" & lr).Value = SpecialBatchNumber
End If
'
If CS.Range("D26").Value = "DO NOT CREATE A SPECIAL BATCH AND DO NOT BACKORDER." & vbCrLf & " " & vbCrLf & "NO CREE UN LOTE ESPECIAL Y NO REALICE PEDIDOS PENDIENTES" Then
MsgBox ("DO NOT CREATE A SPECIAL BATCH AND DO NOT BACKORDER. NOTHING IS REQUIRED OF YOU FOR THIS ITEM." & vbCrLf & " " & vbCrLf & "NO CREE UN LOTE ESPECIAL Y NO REALICE PEDIDOS PENDIENTES. NO SE REQUIERE NADA DE USTED PARA ESTE ARTÍCULO")
End If
'
[COLOR=rgb(251, 160, 38)] If CS.Range("D26").Value = "SEND TO OFFICE TO CREATE A BACKORDER." & vbCrLf & " " & vbCrLf & "ENVIAR A OFICINA PARA CREAR UN PEDIDO PENDIENTE" 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", "G20")
'
For I = 0 To UBound(ArSourceAddress)
PS.Cells(lr, I + 1).Value = CS.Range(ArSourceAddress(I)).Value ' Columns 1 thru 11 .... Array addresses
Next
'
PS.Cells(lr, 12).Resize(, 4).Value = CS.Range("S24").Resize(, 4).Value 'Columns 12,13,14,15 .... S24,T24,U24,V24
'
PS.Cells(lr, 16).Resize(, 2).Value = CS.Range("X24").Resize(, 2).Value ' Columns 15,16 .... X24,Y24
'
MsgBox "THE RECORD HAS BEEN SAVED." & vbCrLf & " " & vbCrLf & "EL REGISTRO SE HA GUARDADO."
''Application.ScreenUpdating = True
End Sub
Sub Email()
Dim oApp As Object
Dim oMail As Object
Set oApp = CreateObject("Outlook.application")
Set oMail = oApp.CreateItem(0)
With OutlookMail
.To = "xxx@xxxxxx.com"
.CC = "xxx@xxxxxx.com"
.BCC = "xxx@xxxxxx.com"
.Subject = "ACTION REQUIRED: ENTER A BACKORDER" & CS.Range("G4").Value & "PO Number " & CS.Range("G20")
.BodyFormat = olFormatHTML
.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
.Send
End With
End Sub
