View Single Post
 
Old 01-07-2015, 01:51 PM
mikey386 mikey386 is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Dec 2014
Posts: 10
mikey386 is on a distinguished road
Default

I've added a link to the worksheet & I've removed any sensitive info. Also, I've included the macro code to my original post. Hth anyone who may be viewing this.

Link to Worksheet: https://app.box.com/s/wrpxoigkpy9x1502h6t0

Code:
Public Sub SendEmails()
    Const cSUBJECT As String = "E1"
    Const cBODY As String = "E2"
    Const cSTART_ROW_INDEX As String = "E3"
    Const cEND_ROW_INDEX As String = "E4"
    
    Const cMAIL_TO_COLUMN As String = "G" ' The column with the email addresses in it
    Const cCOMPANY_NAME_COLUMN As String = "D" ' The column with the Vendor/Company Names in it
    
    
    'Put as many email addresses here as you want, just seperate them with a semicolon
    Const cCC_EMAIL_ADDRESSES As String = "E5"
    
    Const cFROM_ADDRESS As String = "E6"
    
    Dim iRowCount As Integer
    Dim iEndRow As Integer
    
    'Grab the current open worksheet object
    Dim oSheet As Worksheet
    Set oSheet = ActiveSheet
    
    iRowCount = oSheet.Range(cSTART_ROW_INDEX).Value2 ' Get the Start Value
    iEndRow = oSheet.Range(cEND_ROW_INDEX).Value2 ' Get the End Value
    
    Dim dBatchStart As Date
    Dim dBatchEnd As Date
    Dim sVendorName As String
    Dim sEmail As String
    Dim sSubject As String
    Dim sBody As String
    
    'Outlook must already be open, attach to the open instance
    Dim oOutlook As Outlook.Application
    Set oOutlook = GetObject(, "Outlook.Application")
    
    'Declare a new draft email object
    Dim oMail As Object
    Set oMail = oOutlook.CreateItem("olMailItem")
            
    'Start iterating through all the rows of mail, creating a new draft each loop
    Do Until iRowCount = (iEndRow + 1)
    
        'Actually instantiate the new draft email object
        Set oMail = oOutlook.CreateItem(olMailItem)
        
        'Display the draft on screen to the user can see and validate it
        oMail.Display
                      
        'Get the subject, also, substitute the tags for Company and Start Date with the values in the sheet
        sSubject = oSheet.Range(cSUBJECT).Value2
        sSubject = Replace(sSubject, "", oSheet.Range(cCOMPANY_NAME_COLUMN & iRowCount).Value2)
        
        'Now insert the formatted subject into the draft email
        oMail.Subject = sSubject
        
        'Get the Body, substitute the tags for Start Date and End Date with the values in the sheet
        sBody = oSheet.Range(cBODY).Value2
          
        'Now insert the formatted Body into the draft email
        oMail.HTMLBody = sBody
        
        'Set the CC address based on the Constant at the top
        oMail.CC = oSheet.Range(cCC_EMAIL_ADDRESSES).Value2
        
        oMail.Save
        'Set the actual sender of the name. It won't display for the user, but will actually sent as that address
        oMail.SentOnBehalfOfName = oSheet.Range(cFROM_ADDRESS).Value2
        oMail.Save
Reply With Quote