none
Sendmail Function in VBA Excel/Outlook

    Question

  • Hello,

    I need help adding the from line in the below code.  The below code works fine now, but I would like to add the from line and send it on behalf of a group distribution list.  I have tried multiple combinations such as From and .from, sendfrom, mailfrom, fromto. Please help.

    Private Sub CommandButton1_Click()
    sendemail
    End Sub
        
    Public Function sendemail()
    On Error GoTo ende
    esubject =
    sendto =
    ccto =
    ebody =
    newfilename =

    Set app = CreateObject("Outlook.Application")
    Set itm = app.createitem(0)

    With itm
    .Subject = esubject
    .To = sendto
    .cc = ccto
    .body = ebody
    .attachments.Add (newfilename)
    .Display
    .Send
    End With
       
    Set app = Nothing
    Set itm = Nothing

    ende:
    End Function
    Thanks and regards,
    Leonard
    NYLT1@hotmail.com

    Thursday, May 21, 2009 1:43 PM

Answers

  • Please find modification in bold.

    Public Function sendemail()
    On Error GoTo ende
    esubject = "" ''' Apply you subject here
    sendto = "" ' apply send to email
    ccto = "" ''ccto email
    ebody = "" ''' body details
    newfilename = "" ''' location of file
    SentOnBehalfOfName = "" '' email id for Sent On Behalf Of Name like team@yourcompany.com

    Set app = CreateObject("Outlook.Application")
    Set itm = app.createitem(0)

    With itm
    .Subject = esubject
    .SentOnBehalfOfName = SentOnBehalfOfName
    .To = sendto
    .cc = ccto
    .body = ebody
    .attachments.Add (newfilename)
    .Display
    .Send
    End With
      
    Set app = Nothing
    Set itm = Nothing

    ende:
    End Function

    Rgrds, Brij http://accessvbadeveloper.wordpress.com
    • Marked as answer by NYLT1 Tuesday, June 02, 2009 9:48 PM
    Tuesday, June 02, 2009 4:50 AM
  • Hello,

    Please disregard, I figured it and successfully tested it on my own.

    Regards,
    Leonard
    • Marked as answer by NYLT1 Wednesday, June 10, 2009 9:23 PM
    Wednesday, June 10, 2009 9:23 PM

All replies

  • Hi, as far as I know VBA try's to block changing the sender ID for security reasons. See below from the help text:

    Microsoft Outlook blocks code that attempts to access the SenderEmailAddress property for security reasons. If you run a third-party add-in, custom solution, or other program that uses the SenderEmailAddress property in Microsoft Office Outlook 2003, you may receive the following warning:

    A program is trying to access e-mail addresses you have stored in Outlook. Do you want to allow this? If this is unexpected, it may be a virus and you should choose "No".

    Thursday, May 21, 2009 5:26 PM
  • Hi ADG,

    Thanks for the info.  Do you know of any third party software that Microsoft reccomends for out look 2003 which would enable me to send from a group distibution list via VBA?  I have permission to send emails on behalf of group addresses, but the process doesnt work when I try to automate in a macro I've created in VBA.

    Would the above sendmail function work in excel/outlook 2007?

    Thanks and regards,
    Leonard

    Thursday, May 21, 2009 8:07 PM
  • Use need function which returns email of all the member of distribution list,

    Please go through below function.

    You need to pass valid group name, For example i am passing Group name "Friends ".

    if you group does not exist the it will return the same value which was passed as parameter, you can modify it as your requirement.

    Hope it will fulfill you requirement.

    Best wishes. Thanks.

    Option Explicit
    '''' This is for testing purpose
    Sub newtest()
    dim strGroup as string
    strGroup =
    "Friends "
       Debug.Print GetMemberListFromGroup(strGroup )
    End Sub

    Function GetMemberListFromGroup(m_Group_Name As String) As String

    On Error GoTo Error_GetMemberListFromGroup

    Dim myOlApp As Outlook.Application
    Dim myNamespace As Outlook.Namespace
    Dim myFolder As MAPIFolder
    Dim myItem As Outlook.DistListItem
    Dim m_Result As String

    Set myOlApp = CreateObject("Outlook.Application")
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNamespace.GetDefaultFolder(olFolderContacts)

    Set myItem = myFolder.Items(m_Group_Name)

    Dim m_MemberCounter As Long
    m_Result = ""

        For m_MemberCounter = 1 To myItem.MemberCount
            m_Result = m_Result & Trim(myItem.GetMember(m_MemberCounter).AddressEntry) & ";"
        Next
        GetMemberListFromGroup = m_Result
    Exit Function
    Error_GetMemberListFromGroup:
    'MsgBox Err.Description, , Err.Number
    ''''' If you function doesnot found group name it will return the same value.
        GetMemberListFromGroup = m_Group_Name
    End Function


    Rgrds, Brij http://accessvbadeveloper.wordpress.com
    • Proposed as answer by WPF_Rock Monday, May 25, 2009 8:39 AM
    Sunday, May 24, 2009 4:46 AM
  • Hello,

    Thank you for your response.  Unfortunately I am not able to get the above code to work.  The error message I receive states that the function getmemberlistfromgroup is not valid. I am also failing to understand the logic of the need function being applied here as per your comments below it returns the email of all the members of the distribution list?

    Based off my above code which i have successfuly tested and used, is there a way to have the group distribution list i am a part of automatically populated via VBA?  I am looking to send out 60+ emails with attachments to unique addresses on behalf of my group address.  I can do this one by one, but  given the amount of emails I need to send out, automating the process is a must.

    There must be some code that will enable me to send out these emails on behalf of my group address.

    Thoughts and comments appreciated.

    Regards,


    Private Sub CommandButton1_Click()
    sendemail
    End Sub
        
    Public Function sendemail()
    On Error GoTo ende
    esubject =
    sendto =
    ccto =
    ebody =
    newfilename =

    Set app = CreateObject("Outlook.Application")
    Set itm = app.createitem(0)

    With itm
    .Subject = esubject
    .To = sendto
    .cc = ccto
    .body = ebody
    .attachments.Add (newfilename)
    .Display
    .Send
    End With
       
    Set app = Nothing
    Set itm = Nothing

    ende:
    End Function

    Tuesday, May 26, 2009 7:40 PM
    • Function returns emails of all group member.
    • I found this is the way through that you can send email to your group, of course we are populating email from address book and using it through VBA CODE.
    • I had tested this function and its working very well, may be you are using late binding that may be the issue. Try to add reference of outlook in your project and then check this function or convert this function into late binding, choice is yours.
    • Well its great that your email sending function is working and tested properly , so you need to modify only ".To" property of object itm. 
    Can you please follow below steps,

    this is for testing purpose. So
    • Open new blank vba project file (MS-Access or Ms-Excel or Outlook itself) ,
    • Press Alt+F11 ,
    • in visual basic editor add new Module ,
    • Add reference of Outlook .

    Now in Module, Paste below code. and change variable strGroup  with appropriate "Group Name" as per your outlook address book.

    Option Explicit

    Sub SendEmailToGroup() '''' this is the mail testing method you need to run.
    '''''''''''
    Dim EmailList  As Variant
    Dim icounter As Long

    Dim strGroup As String
    Dim strMembersOfGroup As String
    strGroup = "MyDemo"

        strMembersOfGroup = GetMemberListFromGroup(strGroup)

        EmailList = Split(strMembersOfGroup, ";")
       
        For icounter = 0 To UBound(EmailList)
            If EmailList(icounter) <> "" Then
                sendEmail (EmailList(icounter))
            End If
        Next
    '''''''''''
    End Sub

    Sub sendEmail(strEmail As String)
    ''''''''''''''''''''''''''''''''''
    'Apply your currently working email logic here
    ''''''''''''''''''''''''''''''''''
    Debug.Print strEmail      '''' This is for For testing , you can use message box
    End Sub


    Function GetMemberListFromGroup(m_Group_Name As String) As String

    On Error GoTo Error_GetMemberListFromGroup

    Dim myOlApp As Outlook.Application
    Dim myNamespace As Outlook.Namespace
    Dim myFolder As MAPIFolder
    Dim myItem As Outlook.DistListItem
    Dim m_Result As String

    Set myOlApp = CreateObject("Outlook.Application")
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNamespace.GetDefaultFolder(olFolderContacts)

    Set myItem = myFolder.Items(m_Group_Name)

    Dim m_MemberCounter As Long
    m_Result = ""

        For m_MemberCounter = 1 To myItem.MemberCount
            m_Result = m_Result & Trim(myItem.GetMember(m_MemberCounter).Address) & ";"
        Next
        GetMemberListFromGroup = m_Result
    Exit Function
    Error_GetMemberListFromGroup:
    'MsgBox Err.Description, , Err.Number
    ''''' If you function doesnot found group name it will return the same value.
        GetMemberListFromGroup = m_Group_Name
    End Function




    Rgrds, Brij http://accessvbadeveloper.wordpress.com
    • Edited by WPF_Rock Wednesday, May 27, 2009 5:19 AM update
    Wednesday, May 27, 2009 5:03 AM
  • Hi,

    Thanks for the quick response.

    I think the issue here is that the code you supplied is for sending emails to my group address, I am trying to automate sending emails on behalf of my group address. 

    I have permission to send out emails on behalf of my group distribution list, but do not want to manually type that in the from line each time I have to send out an email on behalf of my team. 

    My current code can send out all 60 emails to unique addresses, but my email (ie anyone@anycompany.com) address will be listed in the from line.  I want to automate this process and have the from line listing my teams group address (ie team@anycompany.com), so it appears the emails are coming from the group distribution list.

    Thanks and regards,
    Leonard
    Wednesday, May 27, 2009 12:23 PM
  • You need to use property name SentOnBehalfOfName for sending email behalf of your team. please check below code.
    It working in my system. Lets try in yours.

    Dim imyMailItem As Outlook.MailItem
    Dim myOlApp As Outlook.Application
    Set myOlApp = Outlook.Application
    Set imyMailItem = myOlApp.CreateItem(olMailItem)
        
    imyMailItem.SentOnBehalfOfName = "team@anyCompany.com"
    imyMailItem.To = "anyCompany@anyCompany.com"
    imyMailItem.Subject = "Testing"
    imyMailItem.Body = "Body"
    imyMailItem.Display


    Best wishes.



    Rgrds, Brij http://accessvbadeveloper.wordpress.com
    • Proposed as answer by WPF_Rock Sunday, May 31, 2009 12:56 PM
    Sunday, May 31, 2009 12:56 PM
  • Hello,

    Thank you for the code.  Based on the above, how would you advise I successfully implement it into the below?

    Private Sub CommandButton1_Click()
    sendemail
    End Sub
        
    Public Function sendemail()
    On Error GoTo ende
    esubject =
    sendto =
    ccto =
    ebody =
    newfilename =

    Set app = CreateObject("Outlook.Application")
    Set itm = app.createitem(0)

    With itm
    .Subject = esubject
    .To = sendto
    .cc = ccto
    .body = ebody
    .attachments.Add (newfilename)
    .Display
    .Send
    End With
       
    Set app = Nothing
    Set itm = Nothing

    ende:
    End Function

    Thanks and regards,

    Leonard

    Monday, June 01, 2009 7:52 PM
  • Please find modification in bold.

    Public Function sendemail()
    On Error GoTo ende
    esubject = "" ''' Apply you subject here
    sendto = "" ' apply send to email
    ccto = "" ''ccto email
    ebody = "" ''' body details
    newfilename = "" ''' location of file
    SentOnBehalfOfName = "" '' email id for Sent On Behalf Of Name like team@yourcompany.com

    Set app = CreateObject("Outlook.Application")
    Set itm = app.createitem(0)

    With itm
    .Subject = esubject
    .SentOnBehalfOfName = SentOnBehalfOfName
    .To = sendto
    .cc = ccto
    .body = ebody
    .attachments.Add (newfilename)
    .Display
    .Send
    End With
      
    Set app = Nothing
    Set itm = Nothing

    ende:
    End Function

    Rgrds, Brij http://accessvbadeveloper.wordpress.com
    • Marked as answer by NYLT1 Tuesday, June 02, 2009 9:48 PM
    Tuesday, June 02, 2009 4:50 AM
  • Hello,

    I have been giving thought to incorporating a loop to copy in information from the spread sheet I have as oppossed to hard coding the 70 addresses and copying the code over and over again.

    Any thoughts on how I would be able to successfully incorporate a loopp into the below based off the below column headings?

    Esubject
    SentonBehalfofName
    EmailTo
    CCTo
    Ebody
    NewFileName


    Private Sub CommandButton1_Click()
    sendemail
    End Sub

    Public Function sendemail()
    On Error GoTo ende
    esubject = "" ''' Apply you subject here
    sendto = "" ' apply send to email
    ccto = "" ''ccto email
    ebody = "" ''' body details
    newfilename = "" ''' location of file
    SentOnBehalfOfName = "" '' email id for Sent On Behalf Of Name like team@yourcompany.com

    Set app = CreateObject("Outlook.Application")
    Set itm = app.createitem(0)

    With itm
    .Subject = esubject
    .SentOnBehalfOfName = SentOnBehalfOfName
    .To = sendto
    .cc = ccto
    .body = ebody
    .attachments.Add (newfilename)
    .Display
    .Send
    End With
      
    Set app = Nothing
    Set itm = Nothing

    ende:
    End Function

    Thanks and regards,
    Leonard
    • Marked as answer by NYLT1 Monday, June 29, 2009 8:49 PM
    • Unmarked as answer by NYLT1 Monday, June 29, 2009 8:49 PM
    Tuesday, June 09, 2009 2:23 PM
  • Hello,

    Please disregard, I figured it and successfully tested it on my own.

    Regards,
    Leonard
    • Marked as answer by NYLT1 Wednesday, June 10, 2009 9:23 PM
    Wednesday, June 10, 2009 9:23 PM