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

Filed under:
|
|
|
|

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

Related posts about vba

Related posts about outlook