Email from excel

[sn0border]

I have found a program that will allow me to send an email from excel to people. I have been playing with it and i have tested it, and it works. However what i am trying to build is a program in VBA that will build an email address. lets say A1 is first name. B2 is last name. and attach that to @domain name.com. If that makes sense. What i am trying to do is build a list of names that contain many people rather than go through the global attach this to a button and hit send. the program code i have is listed below. I am not very advanced in my programming abilities any help would be greatly appreciated/

Sub SetRecipients()
Dim aOutlook As Object
Dim aEmail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String


Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
'set sheet to find address for e-mails as I have several people to mail to
Set rngeAddresses = ActiveSheet.Range("A3:A3")
For Each rngeCell In rngeAddresses.Cells
strRecipients = strRecipients & ";" & rngeCell.Value
Next
'set Importance
aEmail.Importance = 2
'Set Subject
aEmail.Subject = "Personal Items To Be Picked up"
'Set Body for mail
aEmail.Body = "If you are recieving this message there are items you need to pick up"
'Set attachment
'aEmail.ATTACHMENTS.Add ActiveWorkbook.FullName
'Set Recipient
aEmail.To = strRecipients
'or send one off to 1 person use this static code
'aEmail.Recipients.Add "E-mail.address-here@ntlworld.com"
'Send Mail
aEmail.Send


End Sub

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

Something like this should work:

Sub SetRecipients()

    Dim aOutlook As Object
    Dim aEmail As Object
    Dim rngeAddresses As Range, rngeCell As Range
    Dim strRecipients As String, strAddress As String, strDelim As String
    
    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)
    
    'set sheet to find address for e-mails as I have several people to mail to
    Set rngeAddresses = ActiveSheet.Range("A2:A3")
    
    strDelim = ""
    For Each rngeCell In rngeAddresses.Cells
        strAddress = rngeCell.Value & "." & rngeCell.Offset(0, 1).Value & "@DomainName.com"
        strRecipients = strRecipients & strDelim & strAddress
        strDelim = ";"
    Next
    
    'set Importance
    aEmail.Importance = 2
    'Set Subject
    aEmail.Subject = "Personal Items To Be Picked up"
    'Set Body for mail
    aEmail.Body = "If you are recieving this message there are items you need to pick up"
    'Set attachment
    'aEmail.ATTACHMENTS.Add ActiveWorkbook.FullName
    'Set Recipient
    aEmail.To = strRecipients
    'or send one off to 1 person use this static code
    'aEmail.Recipients.Add "E-mail.address-here@ntlworld.com"
    'Send Mail
    aEmail.Send

End Sub

For my test I put my names in rows 2 and three in columns A and B.
The Loop just increments down the rows so only column A needs to be referred to.

I have added a variable strAddress to try and make the code more easily understandable.
strDelim was added to remove the initial semi-colon in the recipient list. This is not strictly necessary.