Auto Email from Excel using VBA

[humsboyle]

Currently at present I use VBA code (included at bottom) to allow auto email at click of bottom, which works fine however i would like to make the following amendments but i am unsure where to go.

1) when code is run, before email is sent a Microsoft Outlook Pop-up occurs asking the user to press yes to send the email - is there any way to remove this pop-up and have the email sent automatically?

2) Is it possible to adjust the code for multiple emails to be sent but having different Cell info attached to the email and sent to different address?
i.e Email one containing Cells A1:A10 to email1.com, Email two containing Cells B1:B10 to email2.com etc etc.

The VBA code i have been using after finding on web

Sub Mail_Selection_Range_Outlook_Body()

' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    'Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'You can also use a range if you want
    Set rng = Sheets("sheet1").Range("C5:D9").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "me@myemail.co.uk"
        .CC = ""
        .BCC = ""
        .Subject = "expired case - " + Range("D5")
        .HTMLBody = RangetoHTML(rng)
        .Send   'or use .Display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
[code]

Any help on this matter would be greatly appreciated.

thanks

Steve

 

[humsboyle]

any ideas guys?

 

[John_w]

1 - See http://www.rondebruin.nl/mail/prevent.htm

2 - In short, yes it is possible. But the specific code depends on putting the email addresses in a specific column and looping through them. For the cells to be included in the email, is it always A1:A10 for email1, B1:B10 for email2, etc? If not, you'll have to store this range as a string in another column on the same row as the associated email address, so that the code knows which range to put in the email.

 

[humsboyle]

1 - See http://www.rondebruin.nl/mail/prevent.htm

2 - In short, yes it is possible. But the specific code depends on putting the email addresses in a specific column and looping through them. For the cells to be included in the email, is it always A1:A10 for email1, B1:B10 for email2, etc? If not, you'll have to store this range as a string in another column on the same row as the associated email address, so that the code knows which range to put in the email.

Hey thanks for getting back 2 me.

yeah the info to be in included will be in same cell range but on different sheets.
yeah the email address required will be inserted into a specific column but onto different cells. ie email address 1 will be in A1, email address 2 will be a2 etc