VBA to send eMail. Need help.

[pedie]

Is there a way to send eMail from excel using the templete called templete.msg located in C:\trusted\ folder? to email located in cell(1,1) of sheet1 and body in A2.


Thanks in advance.

 

[pedie]

bump!

 

[meldoc]

Hi Pedie

Try this, change the path/file name to match yours, the code is adapted from Ron's code below.
But note that anything that is set in the below code, between the with OutMail/end with, section including the blanks "" will overwrite the corresponding items in the template.

http://www.rondebruin.nl/mail/folder3/smallmessage.htm

And
http://www.rondebruin.nl/mail/tips2.htm

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Mail_Text_From_Txtfile_Outlook()<br><SPAN style="color:#007F00">'Working in Office 2000-2010</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> OutApp <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> OutMail <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> cell <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> strbody <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>      <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> cell <SPAN style="color:#00007F">In</SPAN> ThisWorkbook.Sheets("Sheet1").Range("A2:A10")<br>          strbody = strbody & cell.Value & vbNewLine<br>      <SPAN style="color:#00007F">Next</SPAN><br><br>    <SPAN style="color:#00007F">Set</SPAN> OutApp = CreateObject("Outlook.Application")<br>    <SPAN style="color:#00007F">Set</SPAN> OutMail = OutApp.CreateItemFromTemplate("C:\Users\Brian\Desktop\New folder\MM.msg")<br><br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> OutMail<br>        .To = ThisWorkbook.Sheets("Sheet1").Range("A1").Value<br>        .CC = ""<br>        .BCC = ""<br>        .Subject = ""<br>        .Body = strbody<br>        .Send  <SPAN style="color:#007F00">'or use .Display</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br><br>    <SPAN style="color:#00007F">Set</SPAN> OutMail = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> OutApp = <SPAN style="color:#00007F">Nothing</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[pedie]

Brian, thanks alot. I tried it and seems to work but the the formatting and the back ground images disappears...

But I think this should be okay for now, moreover you have spent too much time helping me out!!!


I appriciate your help Brian.

Regards
Pedie

 

[Ruddles]

Try .HTMLBody = strbody instead of .Body = strbody.

(Not tested here.)

 

[ss6857]

I've search the forum and this is the closest of my problems that I have found. I am trying to send out emails but I think referencing might have changed from excel 2007 to 2010. I will run the macro. There is no error message but it prompts me for my Profile name?? And the emails won't actually send unless Outlook is open. Can anyone help?

Dim OutApp As Object
    Dim OutMail As Object
    Dim EmailTo As String
    Dim EmailCC As String
    Dim EmailSub As String
    Dim EmailBody As String
    Dim EmailFrom As String
 
vFilePath = Range("rFilePath").Value
     EmailFrom = Range("EmailFrom").Value
'    EmailTo = Range("Email_List").Value
 '   EmailCC = Range("EmailCC").Value
     EmailSub = Range("EmailSub").Value
  '  EmailBody = Range("EmailBody").Value
 
Set OutApp = CreateObject("Outlook.Application")
        Set OutNS = OutApp.GetNamespace("MAPI")
        OutNS.Logon
        'OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        
       
        '.From = EmailFrom
        Dim accounts As Outlook.accounts
        Dim Account As Outlook.Account
        Dim MyAccount As Outlook.Account
        Set accounts = OutNS.accounts
        
        .To = EmailTo
        .CC = EmailCC
        .BCC = ""
        .Subject = EmailSub
        .Body = EmailBody
        .Attachments.Add ActiveWorkbook.FullName
        
 ' Loop over the Accounts collection of the current Outlook session.
        For Each Account In accounts
            ' When the e-mail address matches, return the account.
            If Account.SmtpAddress = EmailFrom Then
                ' Use this account to send the e-mail.
                Set MyAccount = Account
            End If
        Next
       Set .SendUsingAccount = MyAccount
       ' If xfile = 1 Then
         '  .Attachments.Add ("S:\Path\To\Attachment")
       ' End If
       ' On Error GoTo 0
        .Display
        '.Send
        
        Set OutMail = Nothing
        Set MyAccount = Nothing
        Set accounts = Nothing
        Set OutNS = Nothing
        Set OutApp = Nothing

 

[meldoc]

Hello ss6857

I'm certainly no expert, and I can't help with the first part of your question.
But for the second part, will the macro actually send any emails with the Send commented out.

.Display
[COLOR="Red"]'[/COLOR].Send

This is the place for help on all things email.

http://www.rondebruin.nl/sendmail.htm

 

[ss6857]

Yeah, I just did that too see if the email was actually being created and they are. But that doesn't fix my problem of the emails not being sent unless outlook is open.
Thanks for your input though... Anybody else have any ideas?

 

[AntMac]

Maybe you can help with mine. :D I have a code that seems to work, my work setup only lets me confirm the message is in the outbox. But there is a message that pops up saying there is a program trying to automatically send an email. Do you want to allow. Is there anyway to avoid this popup?

 

[meldoc]

Hello

See the link.

http://msdn.microsoft.com/en-us/library/aa175241(v=office.11).aspx