Excel VBA Doesnt Send Email with .Display but does with .Send
14:26 26 Feb 2026

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 & "" emailBody = emailBody & "" emailBody = emailBody & "" emailBody = emailBody & "
[Online acceptance button] to accept this quote online.

" 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
excel vba