VBA Email Automation / VBA Mail Automation
Sub Send_Mail_From_Excel()
' This is an automatic mail program. It takes the mail Id's from activeworkbook and uses outlook object to send mail
' The format of the workbook should be as follows
' 1. Data Should start from Row 2 - Sheet 1
' 2. Salutation in Col 1 -e.g., Mr, Ms, Dr etc
' 3. Name in Col 2 -e.g., Sheetal
' 4. Email in Col 4 -e.g., sheetal@vbadud.com
' Program will loop through the entire sheet and send mails to all
Dim oXlWkBk As Excel.Workbook ' Excel Work Book Object
Dim oOLApp As Outlook.Application
Dim oOLMail As MailItem
Dim lRow As Long
Dim olMailItem
Dim sMailID As String
Dim sSalutation As String
Dim sName As String
Dim sDetails As String
Dim sSubject As String
On Error GoTo Err_Trap
Set oXlWkBk = ActiveWorkbook
If oXlWkBk.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Row < oolapp =" New" lrow =" 2" oolmail =" oOLApp.CreateItem(olMailItem)" ssalutation =" oXlWkBk.Sheets(1).Cells(lRow," sname =" oXlWkBk.Sheets(1).Cells(lRow," sdetails = "Hi"> 0 And LenB(Trim$(sSalutation)) <> 0) Then
sDetails = sSalutation & " " & sName
ElseIf LenB(Trim$(sName)) <> 0 Then
sDetails = sName
Else
sDetails = "Hi"
End If
sDetails = sDetails & vbNewLine & vbNewLine
sMailID = Trim$(oXlWkBk.Sheets(1).Cells(lRow, 3).Value)
' --- Validate EMail ID
If InStr(1, sMailID, "@") = 0 Then
GoTo TakeNextRow
End If
' Create Mail
With oOLMail
.To = sMailID
.Subject = sSubject
.Body = sDetails & "This is a test mail from VBA Tips & Tricks (http://vbadud.blogspot.com/)"
End With
oOLMail.Send
TakeNextRow:
Next lRow
oXlWkBk.Close (False)
'--------------------------------------------------------
' Coded by Shasur for http://vbadud.blogspot.com
'--------------------------------------------------------
Destroy_Objects:
'Destroy Objects
If Not oOLApp Is Nothing Then Set oOLApp = Nothing
Err_Trap:
' Error Handling
If Err <> 0 Then
MsgBox Err.Description, vbInformation, "VBADUD AutoMail"
Err.Clear
GoTo Destroy_Objects
End If
'------------------------------------------------------------------------------------
' Disclaimer: VBA Tips & Tricks (http://vbadud.blogspot.com) publishes this content
' for the intention of sharing technical knowledge. Any misuse of this program (e.g., spamming)
' will not be our responsibility.
'------------------------------------------------------------------------------------
End Sub
'Keywords: 'Keywords: Automate Email, VBA Email, Send Email from Excel, VBA Mail automation, Mail Automation, Outlook VBA, Automate Outlook, Send Mail from Outlook, Link Excel with Outlook,Microsoft Outlook Mail Automation, Excel VBA Mail, MAPI, Send Multiple eMails
If you want to try the same using Lotus Notes refer http://vbadud.blogspot.com/2007/10/automate-lotus-notes-email-using-visual.html
Tuesday, April 24, 2007
Download Windows Live Toolbar and personalize your Web experience! Add custom buttons to get the information you care about most.
Posts
Your post in the MSDN forum (http://forums.microsoft.com/MSDN/showpost.aspx?postid=1834289&siteid=1) implies that your solution avoids the "A progam is trying to automatically send e-mail on your behalf" warning? I don't see how it does so, could you explain?
ReplyDelete'' AYP ''
DeleteDim oXlWkBk As Excel.Workbook ' Excel Work Book Object
Dim oOLApp As Object ' Outlook Application Object
Dim oOLMail As Object ' Outlook Application Item Object
Set oOLApp = CreateObject("Outlook.Application")
Set oOLMail = oOLApp.CreateItem(olMailItem)
' Creating E-Mail
Set oXlWkBk = ActiveWorkbook
With oOLMail
.To = "apenachi@medimedia.com"
.Subject = "TESTing"
.Body = "This is a test mail from VBA "
End With
oOLMail.Send
I've been looking for this. Thanks for sharing.
ReplyDeletehttp://vbaexcel.eu/vba-macro-code/email-sender-vba-outlook
ReplyDeleteHere is an alternative solution! I use excel to email alot! It is a good soultion where you can control all techincal details!
Hi,
ReplyDeleteI am trying to make a macro work for each sheet in a worksheet.
This is my code and I would like it to work without pressing the assigned keys for each sheet:
Activesheet.Protect Password:="xxx", DrawingObjects:=False, contents:=True, Scenarios:=
False, AllowFormattingCells:=True, userinterfaceonly:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
Thanks
Since your code references the ActiveSheet you need to activate each sheet before running the code.
ReplyDeleteElse you can loop through the Sheets collections
For Each Sht in Worksheets
Next Sht
HTH
Sub SendEmail()
ReplyDeleteDim oXlWkBk As Excel.Workbook ' Excel Work Book Object
Dim oOLApp As Object ' Outlook Application Object
Dim oOLMail As Object ' Outlook Application Item Object
Set oOLApp = CreateObject("Outlook.Application")
Set oOLMail = oOLApp.CreateItem(olMailItem)
' Creating E-Mail
Set oXlWkBk = ActiveWorkbook
With oOLMail
.To = "apenachi@medimedia.com"
.Subject = "TESTing"
.Body = "This is a test mail from VBA "
End With
oOLMail.Send
End Sub
Actually you can replace "olMailItem" with a zero (0)
ReplyDelete