Send Outlook mail from Excel

[nianchi111]

Hi All,

I found a code to send email, this takes all the email address only from column A and displays it in TO address as email ID1; eamil ID2; till last mail ID.



Sub Outlook_Email()
'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String

'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)

'Using the email, add multiple recipients, using a list of addresses in column A.
With olMailItm
SDest = ""
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
If SDest = "" Then
SDest = Cells(iCounter, 1).Value
Else
SDest = SDest & ";" & Cells(iCounter, 1).Value
End If
Next iCounter

'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
'.BCC = SDest
.To = SDest
.Subject = "FYI"
.Body = ActiveSheet.TextBoxes(1).Text
.Attachments.Add ("C:\Users\sks148\Desktop\vimal - DO NOT DELETE\Mexico Statements123\Picture1.png")
.Display
' .Send
End With

'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub

What I require:

Column A B C D E
Names1 na@dot.com ma@dot.com
Name2 12@g.com 24@g.come 43@g.com 244@g.com
Name3 nanak@y.com

Something similar to the above table,. for some cases i have email address till column H.

For example for Name2 its has to be 12@g.com; 24@g.com; 43@g.com; 244@g.com in the TO address.

Thanks,
Vimal Vikraman.

 

[Coding4Fun]

Maybe?

Sub Outlook_Email()
'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim xCounter As Integer
Dim Dest As Variant
Dim SDest As String


'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)


'Using the email, add multiple recipients, using a list of addresses in column A.
With olMailItm
SDest = ""
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
    For xCounter = 1 To WorksheetFunction.CountA(Rows(iCounter))
        If SDest = "" Then
             SDest = Cells(iCounter, 1).Value
        Else
             SDest = SDest & ";" & Cells(iCounter, xCounter).Value
        End If
    Next xCounter
Next iCounter


'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
'.BCC = SDest
.To = SDest
.Subject = "FYI"
.Body = ActiveSheet.TextBoxes(1).Text
.Attachments.Add ("C:\Users\sks148\Desktop\vimal - DO NOT DELETE\Mexico Statements123\Picture1.png")
.Display
' .Send
End With


'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub

 

[nianchi111]

Hi,

Thank you for the reply...

This works fine and takes all the email IDs from the sheet and creates outlook item.

However what i was looking for is that first it has to check he Row # 1 from A1 till H1 and from this how many email IDs are there it has to create an outlook item and then move to the next row. This has to continue until last cell in column A.

Please excuse me if i was not clear.

Thanks,
Vimal Vikraman.

 

[Coding4Fun]

Not a problem, I had a feeling that is what you were actually after, was not sure if you wanted each row in a seperate email or everything in one email.

The version below will take all the emails in a single row and create an email from them, continuing through the list until it reaches the end of column A.

Note if you really want it to just check A to H then see the commented code on making it so, as it is currently set it will check the row based on all cells with data in the row. The reason being if you happen to expand and have more than 8 emails on a row then you would have to adjust the code from 8 to 9 and then from 9 to... etc. By doing it this way it allows it to expand and count how far right it needs to check.

Sub Outlook_Email()
'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim xCounter As Integer
Dim Dest As Variant
Dim SDest As String


For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)


'Using the email, add multiple recipients, using a list of addresses in column A.
With olMailItm
SDest = ""


For xCounter = 1 To WorksheetFunction.CountA(Rows(iCounter)) ' Change this to - For xCounter = 1 To 8
If SDest = "" Then
SDest = Cells(iCounter, 1).Value
Else
SDest = SDest & ";" & Cells(iCounter, xCounter).Value
End If
Next xCounter


'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
'.BCC = SDest
.To = SDest
.Subject = "FYI"
'.Body = ActiveSheet.TextBoxes(1).Text
'.Attachments.Add ("C:\Users\sks148\Desktop\vimal - DO NOT DELETE\Mexico Statements123\Picture1.png")
.Display
' .Send
End With


'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing


Next iCounter


End Sub

 

[nianchi111]

Thank you so much... you are a life saver....