Using Excel VBA to send emails. Problem with attachments becoming embedded by accident.
Posted
by Alexei
on Stack Overflow
See other posts from Stack Overflow
or by Alexei
Published on 2010-04-05T15:23:07Z
Indexed on
2010/04/05
15:33 UTC
Read the original article
Hit count: 368
Hi, I am having an issue with an Excel macro I wrote that is used by several users within my company. It is used to send numerous emails daily with attachments that are also Excel workbooks. The issue is that sometimes, instead of the file simply being attached as it should be, it becomes an embedded object. This embedded object is openable by users on the email within the company (after clicking through the "YOu are about to activate an embedded object that may contain viruses or be otherwise harmful to your computer. It is important to be certain that it is from a trustworthy source. Do you want to continue?"), but those outside of the company do not see it at all. The email appears to have no attachment at all.
Curiously, this appears to happen randomly, and only on some computers. So if the list has 15 email lists and attachments, it seems to happen randomly to anywhere between 0 and 15 of the emails. To be clear, my objective is to send emails with regular attachments. Running Excel 2003, Outlook 2003, and Windows XP.
See code below. Please help!
Sub Email()
Dim P As String
Dim N As String
Dim M As String
Dim Subject As String
Dim Addresses As String
Dim olApp As Outlook.Application
Dim olNewMail As Outlook.MailItem
Application.DisplayAlerts = False
M = ActiveWorkbook.Name
For c = 2 To 64000
If Range("B" & c) = "" Then Exit For
If UCase(Range("E" & c)) = "Y" Then
Workbooks(M).Sheets("Main").Activate
Subject = Range("A" & c)
Addresses = Range("B" & c)
P = Range("C" & c)
N = Range("D" & c)
If Right(P, 1) <> "\" Then P = P & "\"
If Right(N, 4) <> ".xls" Then N = N & ".xls"
Set olApp = New Outlook.Application
Set olNewMail = olApp.CreateItem(olMailItem)
With olNewMail
.Display
.Recipients.Add Addresses
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys ("{TAB}")
.Subject = Subject
.Attachments.Add P + N
.Send
End With
Set olNewMail = Nothing
Set olApp = Nothing
End If
Next c
Range("E2:E65536").ClearContents
Application.DisplayAlerts = True
End Sub
© Stack Overflow or respective owner