Email address disappears when send button is clicked, when email is created by Excel VBA, how do I correct this?

Exchange 2013, Outlook 2010, Excel 2010

I have started using the following code, modified from Ron De Bruin code:

The code is used by several users, however one user experiences strange behaviour in Outlook.
His Outlook account seems to work if the email is created by normal manual process.
When an email is created with the following code, the email is displayed in Outlook and appears completely fine.
The email address appears to be of the correct format.
When the send button is clicked, the email address disappears and the email is not sent.
It is not possible to click in the "To" field.

After a reboot and new run of the code, using the same Excel file, the email is sent correctly.

I presume it's a problem with Outlook rather than Excel code but I'm mystified as this behaviour only started since using the code.

Sub EmailModule()
Dim OutApp As Outlook.Application, OutMail As Outlook.MailItem, Salutation As String
Dim strbody As String, FilePath As String, XPath As String, YPath As String, ZPath As String, FolderSave As String
Dim Line1 As String, Line2 As String, Line3 As String, Line4 As String, Line5 As String
Dim Line6 As String, Line7 As String, Line8 As String, Line9 As String, Line10 As String, Line11 As String, Line12 As String
Dim Line13 As String, Line14 As String, Line15 As String, SignOff As String, Lines As String
Dim EMailSub As String, EMailType As String, Doc As String
Dim x As Integer, I As Integer, SDEM As String
Dim EI As Long, Addr As String

Doc = Sheets("Configuration").Range("B10").Value

x = 11
EMailType = "Acknowledgement"

If Doc = "P" Then
x = x + 15
EMailType = "Proforma"
End If

If Left(Doc, 1) = "Q" Then
x = x + 30
EMailType = "Quotation"
End If

If Doc = "EE" Then GoTo SkipEmail

Line1 = Sheets("Configuration").Range("G" & x).Value & " " & Sheets("Quote").Range("D6").Value
Line2 = Sheets("Configuration").Range("G" & x + 1).Value & " " & Sheets("Quote").Range("D14").Value
Line3 = Sheets("Configuration").Range("G" & x + 2).Value
If Doc <> "A" Then
Line4 = Sheets("Configuration").Range("G" & x + 3).Value & " " & Sheets("Quote").Range("G4").Value & " attached"
Line5 = Sheets("Configuration").Range("G" & x + 4).Value
Line4 = Sheets("Configuration").Range("G" & x + 3).Value
Line5 = Sheets("Configuration").Range("G" & x + 4).Value& & " " & Sheets("Quote").Range("G4").Value & " attached"
End If
Line6 = Sheets("Configuration").Range("G" & x + 5).Value
Line7 = Sheets("Configuration").Range("G" & x + 6).Value
Line8 = Sheets("Configuration").Range("G" & x + 7).Value
Line9 = Sheets("Configuration").Range("G" & x + 8).Value
Line10 = Sheets("Configuration").Range("G" & x + 9).Value
Line11 = Sheets("Configuration").Range("G" & x + 10).Value
Line12 = Sheets("Configuration").Range("G" & x + 11).Value

GoTo Hop
EMailType = "Enquiry"
Line1 = Sheets("Configuration").Range("G3").Value & " " & Sheets("Quote").Range("M6").Value
Line2 = ""
Line3 = "Ref " & Sheets("Quote").Range("D14").Value
Line4 = "Please advise price & availability"
Line5 = ""

Salutation = Line1 & "<br>" & _
Line2 & "<br>" & _
Line3 & "<br>" & _
Line4 & "<br>" & _
Line5 & "<br>"

If Sheets("Quote").Range("M8").Value = "Way Train, Taiwan" Then
SDEM = "Yes"
Line11 = Sheets("Configuration").Range("G4").Value
Line12 = Sheets("Quote").Range("D12").Value
Line13 = ""
Line14 = Sheets("Configuration").Range("B29").Value
Line15 = Sheets("Configuration").Range("B30").Value
Line11 = Sheets("Configuration").Range("G4").Value
Line12 = Sheets("Quote").Range("D12").Value
Line13 = ""
Line14 = Sheets("Configuration").Range("B27").Value
Line15 = Sheets("Configuration").Range("B28").Value
End If

SignOff = "" & "<br>" & _
Line11 & "<br>" & _
Line12 & "<br>" & _
Line13 & "<br>" & _
Line14 & "<br>" & _
Line15 & "<br>"

Lines = Salutation

For I = 18 To 77
If Sheets("Quote").Range("B" & I).Value <> "" Then
Lines = Lines & Sheets("Quote").Range("B" & I).Value & " x " & Sheets("Quote").Range("D" & I).Value & "<br>"
End If
If I = 35 Then
I = 56
End If

Next I

Lines = Lines & SignOff

If Sheets("Quote").Range("I4").Value = "" Then
EMailSub = "(" & Sheets("Quote").Range("G4").Value & ")" & " " & Sheets("Quote").Range("D14").Value
EMailSub = "(" & Sheets("Quote").Range("G4").Value & " " & "/" & Sheets("Quote").Range("I4").Value & ")" & " " & Sheets("Quote").Range("D14").Value
End If
GoTo Hop1

If Sheets("Quote").Range("I4").Value = "" Then
EMailSub = EMailType & " " & Sheets("Quote").Range("G4").Value & " " & Sheets("Quote").Range("D14").Value
EMailSub = EMailType & " " & Sheets("Quote").Range("G4").Value & " " & "/" & Sheets("Quote").Range("I4").Value & " " & Sheets("Quote").Range("D14").Value
End If

strbody = Line1 & "<br>" & _
Line2 & "<br>" & _
Line3 & "<br>" & _
Line4 & "<br>" & _
Line5 & "<br>" & _
Line6 & "<br>" & _
Line7 & "<br>" & _
Line8 & "<br>" & _
Line9 & "<br>" & _
Line10 & "<br>" & _
Line11 & "<br>" & _
Line12 & "<br><br><br>"

FolderSave = Sheets("Configuration").Range("B7").Value & "\" & Sheets("Configuration").Range("B1").Value
FilePath = Sheets("Configuration").Range("B5").Value & "\" & FolderSave

If Doc <> "EE" Then
XPath = FilePath & "\" & Range("G4").Value & ".pdf"
YPath = Sheets("Configuration").Range("B4").Value & "\" & Sheets("Configuration").Range("B23").Value
End If
If Sheets("Configuration").Range("B24").Value <> "" Then
ZPath = Sheets("Configuration").Range("B4").Value & "\" & Sheets("Configuration").Range("B24").Value
End If

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

If SDEM = "Yes" Then
Addr = Sheets("Configuration").Range("C29").Value
If Sheets("Configuration").Range("B31").Value = "Yes" Then
Addr = Sheets("Configuration").Range("C31").Value
Addr = Sheets("Configuration").Range("C27").Value
End If
End If

Set OutApp = CreateObject("Outlook.Application")
For EI = 1 To OutApp.Session.Accounts.Count
If OutApp.Session.Accounts.Item(EI) = Addr Then GoTo Skip
Next EI

Set OutMail = OutApp.CreateItem(olMailItem)

On Error Resume Next
With OutMail
If Doc <> "EE" Then
.To = Range("D9").Value
.To = Range("M7").Value
End If
.CC = ""
.BCC = ""
.Subject = EMailSub
.ReadReceiptRequested = True
.Importance = 2
If Doc <> "EE" Then
.HTMLBody = strbody
.HTMLBody = Lines
End If
If (FilePath) <> "" Then
.Attachments.Add XPath
.Attachments.Add YPath
.Attachments.Add ZPath
End If
.SendUsingAccount = OutApp.Session.Accounts.Item(EI)
.Display   'or use .Send
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Open in new window

spar-kleOperations DirectorAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saurabh Singh TeotiaCommented:
Have you tried repairing office by going into-->Start-->Control Panel-->Program & Features and try repairing office and see whether it fixes problem for you...

Alternatively in outlook you can go to file-->options-->trust center-->trust center settings and in their programmatic access and change that to never warn and then you can use .send instead of display which will directly send email rather then showing..

spar-kleOperations DirectorAuthor Commented:
Thanks for your reply Saurabh
I have ran repair and will monitor next week.

I will consider .send as a last result.
I will confirm next week if that's ok?
Saurabh Singh TeotiaCommented:
Sure works out for me..Let me know if you need any other help on this..

Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

spar-kleOperations DirectorAuthor Commented:
Unfortunately we are still experiencing the same problems after repairing Outlook.

I really don't want to change to .send yet.

In as much as the email is displayed correctly, with correct email address and email content is resolved, I presume that there isn't a problem with the VBA code?
Please advise.

I'm wondering if it's down to the fact that the server email accounts are cached on each users PC and shared between users.
The OST files are quite large.
I'm wondering if I should untick the box for "Use cached Exchange mode" in Outlook?
If it's a problem with Outlook I will close this question and reopen another.
What do you think?
Saurabh Singh TeotiaCommented:

I looked into the code and i don't see any problem in this..and you just repair outlook or the whole office?? If not the office i will advise do that since their be something with excel and outlook when they talk to each other at background...

In additional OST should make any difference.. My OST file now is 40 GB's and it works perfectly fine without any problem in the same.. Try repairing office and lets see if that fix the problem or not..

spar-kleOperations DirectorAuthor Commented:
Thanks Saurabh

Yes I repaired Office because Outlook was not listed separately in Programs.
The original PC fails as described, but so do the other PC's, that share the email account fail in the same way.

It is a recent installation of Exchange, so perhaps the problem lies there!

Strangely, if we immediately copy the email body & attachments into a new email, then type the email address in manually, the email sends as expected.
Saurabh Singh TeotiaCommented:
I didn't found again any problem in the code and it seems fine to me..I'm surprised to see the office repair doesn't fix and i'm assuming it's happening with one user i'm thinking what other setting in the pc might be triggering this to happen..

If you do a clean re-install of office check does the issue still persists..

spar-kleOperations DirectorAuthor Commented:
Thank you Saurabh.
Unfortunately other users pc's fail in the same way now.
With one user the email body is displayed but there is no visible email address.
If I hover over the address field a comment appears that shows the address. If I add an address a colon appears as if there is already an address in the field!!
Saurabh Singh TeotiaCommented:
Hmm this is just so weird..and i guess it's something to do with outlook or exchange that you have now.. as the names are not getting pulled.. where the semi-colon is added it show the names or something.. can you try in the code to have a semicolon as in by this and just see if the name shows or not...

If Doc <> "EE" Then
.To = Range("D9").Value  &";"
.To = Range("M7").Value &";"
End If

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
spar-kleOperations DirectorAuthor Commented:
Appreciate your help Saurabh. I will try this tomorrow.
spar-kleOperations DirectorAuthor Commented:
Unfortunately this does not work.
I will open a new question specific to Outlook/Exchange
spar-kleOperations DirectorAuthor Commented:
Just found a workaround but not sure why this is working like this.

I inserted the ";" into code as suggested.
((When the email is created everything looks ok, but if the "Send" button is clicked then the email disappears and the email is not sent))

If I click after the email address in the "To" cell and press delete, then send it seems to be sent as normal.

Any ideas??
spar-kleOperations DirectorAuthor Commented:
Thanks for your help Saurabh.
Awarded as solution because code confirmed as correct, so must be Outlook setup.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.