Tuesday, April 24, 2007

VBA Email Automation / VBA Mail Automation

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

8 comments:

  1. 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
    Replies
    1. Anonymous9:58 AM

      '' AYP ''

      Dim 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

      Delete
  2. Anonymous6:09 AM

    I've been looking for this. Thanks for sharing.

    ReplyDelete
  3. http://vbaexcel.eu/vba-macro-code/email-sender-vba-outlook

    Here is an alternative solution! I use excel to email alot! It is a good soultion where you can control all techincal details!

    ReplyDelete
  4. Anonymous5:52 AM

    Hi,
    I 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

    ReplyDelete
  5. Since your code references the ActiveSheet you need to activate each sheet before running the code.

    Else you can loop through the Sheets collections

    For Each Sht in Worksheets

    Next Sht

    HTH

    ReplyDelete
  6. Anonymous7:56 AM

    Sub SendEmail()
    Dim 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

    ReplyDelete
  7. Anonymous10:19 AM

    Actually you can replace "olMailItem" with a zero (0)

    ReplyDelete

StumbleUpon
Share on Facebook
Related Posts Plugin for WordPress, Blogger...
Download Windows Live Toolbar and personalize your Web experience! Add custom buttons to get the information you care about most.