Option Explicit
Sub Send_Mail()
'this sends an email that sends a text message
Dim OutApp As Object
Dim OutMail As Object
Dim MyButton As String
Dim strTo As String
Dim strCC As String
Dim Body As String
Dim PhNum As String
Dim uRows As String
Dim Answer
'Dim cell
On Error GoTo errhandler
MyButton = ActiveSheet.Shapes(Application.Caller).Name
ResumeHere:
With ActiveSheet.Buttons(MyButton) 'Form Control
Select Case True
Case Application.IsError(Range(.TopLeftCell, .BottomRightCell).Offset(0, -1).Value) And _
Range(.TopLeftCell, .BottomRightCell).Offset(0, -2).Value = ""
GoTo errhandler
Case Application.IsError(Range(.TopLeftCell, .BottomRightCell).Offset(0, -1).Value) And _
Range(.TopLeftCell, .BottomRightCell).Offset(0, -2).Value <> ""
strTo = Range(.TopLeftCell, .BottomRightCell).Offset(0, -2).Value & "@email.co.uk"
Case Else
strTo = Range(.TopLeftCell, .BottomRightCell).Offset(0, -1).Value & "@email.co.uk"
End Select
Body = ("Hello. " & IIf(Range(.TopLeftCell, .BottomRightCell).Offset(, -11) = "", Range(.TopLeftCell, .BottomRightCell).Offset(, -15), Range(.TopLeftCell, .BottomRightCell).Offset(, -11)) & ". " & Range(.TopLeftCell, .BottomRightCell).Offset(, -13) & "-" & Range(.TopLeftCell, .BottomRightCell).Offset(, -12) & ". TIME:" & Range(.TopLeftCell, .BottomRightCell).Offset(, -14) & ". " & IIf(Range(.TopLeftCell, .BottomRightCell).Offset(, -10) = "", "Performance " & Range(.TopLeftCell, .BottomRightCell).Offset(, -14) & "z", "Fail: " & Range(.TopLeftCell, .BottomRightCell).Offset(, -10) & "z. " & "Reason: " & Range(.TopLeftCell, .BottomRightCell).Offset(, -9)) & ". Status valid @ " & Format(Time(), "hh:mm") & "z. Pls do not reply to this msg. ")
End With
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = strTo
.CC = strCC
.BCC = ""
.Subject = "euro22"
.Body = Body
.Display 'Send 'or use .Display
'.BodyFormat = olFormatPlain
End With
Set OutMail = Nothing
Set OutApp = Nothing
With ActiveSheet.Buttons(MyButton)
Range(.TopLeftCell, .BottomRightCell).Offset(0, -3).Value = Now()
With Range(.TopLeftCell, .BottomRightCell).Offset(0, -3)
.Value = Time()
.NumberFormat = ("hh: mm" & "z")
End With
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
With ActiveSheet.Buttons(MyButton)
Range(.TopLeftCell, .BottomRightCell).Offset(0, -10).Interior.Color = RGB(255, 255, 255)
Range(.TopLeftCell, .BottomRightCell).Offset(0, -9).Interior.Color = RGB(255, 255, 255)
End With
Exit Sub
errhandler:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Answer = MsgBox("Phone number for Employee missing. Text not sent." & vbNewLine & _
"Check name and employee number." & vbNewLine & vbNewLine & _
"If you know the number, type it into the box below" & vbNewLine & vbNewLine & _
"Would you like to continue?", vbYesNo)
If Answer = vbNo Then Exit Sub
PhNum = Application.InputBox("Enter the number here", "Employee", Type:=1)
If PhNum = vbNullString Or Len(Trim(PhNum)) = 0 Or PhNum = "False" Then Exit Sub
With ActiveSheet.Buttons(MyButton) 'Form Control
Range(.TopLeftCell, .BottomRightCell).Offset(0, -2).Value = PhNum
End With
GoTo ResumeHere
End Sub
Personally I like using Select Case instead of multiple If statements but you can do it either way. In all cases, should be working now. My other advice to you is to change your programming style by removing "On Error GoTo" and rather specify what the error would look like and quantify it like I did in this example. That way other errors can be captured. Right now all errors will assume that the number is #NA, but it could be something completely different (e.g. different sheet names, etc.).
Bookmarks