When I run this code, the email preview appears perfectly fine, but after I manually click 'send' the email doesn't go to the recipient's inbox neither my sent inbox.
However, if I just use .Send the email sends instantly with no issues.
My Outlook Version is 1.2026.210.300
Hopefully someone can find out what is causing this as I did have this working on a different Excel Document.
The code is as follows:
Sub SendQuote()
Dim ws As Worksheet
Dim buttonRow As Long
Dim shp As Shape
Dim OutApp As Object
Dim OutMail As Object
Dim emailBody As String
Dim customerName As String
Dim customerEmail As String
Dim reference As String
Dim wbPath As String
Dim filePath As String
'Worksheet for Macro
Set ws = ThisWorkbook.Worksheets("Jobs")
'Detect Clicked Shape and Row
Set shp = ws.Shapes(Application.Caller)
buttonRow = shp.Top / ws.Rows(1).Height
buttonRow = Int(buttonRow) + 1 'Round to nearest row
'Fill Next Column Green to Mark as Sent
ws.Cells(buttonRow, shp.TopLeftCell.Column + 1).Interior.Color = RGB(0, 176, 80)
'Get Customer Details
customerName = ws.Cells(buttonRow, "D").Value
customerEmail = ws.Cells(buttonRow, "J").Value
reference = ws.Cells(buttonRow, "B").Value
'Debug
'MsgBox "Name: " & customerName & vbCrLf & _
' "Email: " & customerEmail & vbCrLf & _
' "Reference: " & reference & vbCrLf & _
' "Button: L" & buttonRow & vbCrLf & _
' "Sheet: " & ws.Name
'Start Outlook
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Editable Email Contents
paymentTerms = "We take a small deposit prior to your move. During the unload at your destination, our team leader will request payment via BACS or credit/debit card."
footer = "Yours Sincerely,
" & _
"David Shepherd
" & _
"Beemoved First Ltd
" & _
"01582 851549
" & _
"beemovedfirst.co.uk"
'HTML Email Body
emailBody = ""
emailBody = emailBody & "Dear " & customerName & ",
"
emailBody = emailBody & "Thank you very much for your valued enquiry. It was a pleasure to meet you to discuss your moving requirements.
"
emailBody = emailBody & ""
emailBody = emailBody & ""
emailBody = emailBody & "[Online acceptance button] "
emailBody = emailBody & " "
emailBody = emailBody & " to accept this quote online. "
emailBody = emailBody & "
"
emailBody = emailBody & paymentTerms & "
"
emailBody = emailBody & "We have fully trained, uniformed staff, providing you with a friendly, stress free and professional removal.
"
emailBody = emailBody & "
"
emailBody = emailBody & "Please find your quote attached and should you have any questions, please contact the main office where we will be happy to discuss your quotation further.
"
emailBody = emailBody & footer
emailBody = emailBody & ""
With OutMail
'Main Email
.To = customerEmail
.Subject = "Your Quote from Beemoved First Ltd - Ref " & reference
.HTMLBody = emailBody
'Attachments Location
wbPath = ThisWorkbook.Path
filePath = wbPath & "\Attachments\Beemoved First Insurance Terms & Conditions.pdf"
'Attachments
.Attachments.Add filePath, 1, , "Terms & Conditions"
.Display
End With
Set OutApp = Nothing
Set OutMail = Nothing
End Sub