Email different emails different cell ranges

[andrewb90]

Hello All,

I was wondering if it was possible to email a cell range to a specific email and then a different cell range to a different email?
I already use CDO to email a pdf to an email list, but this is much different and I'm not really sure if it is doable.

A few details:
The emails would be K6:L42. Each person has up to 2 emails. There can and will be blanks.
The cell range that needs to get emailed is a little trickier. All the emails need the range Print!D1:AB4, however each row on the email list would get a row just for them K6:L6 would get Print!D6:AB6, and so on so forth down the sheet.

I hope this all makes sense and that somebody can give some insight on how to make this work.

 

[humdingaling]

did you want to email cell range as image in the email?
not sure if CDO is different but here is example i did with outmail

Option Explicit
Sub createJpg(Namesheet As String, nameRange As String, nameFile As String)
    
    Dim plage As Object
    
    ThisWorkbook.Activate
    Worksheets(Namesheet).Activate
    
    Set plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange)
    plage.CopyPicture
    
    With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(plage.Left, plage.Top, plage.Width, plage.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
    
    Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
    Set plage = Nothing

End Sub

Sub sendMail()
        
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
     
    Dim TempFilePath As String 'location of temp image
    Dim imgRNG As String 'area for image
    Dim OutApp As Object
    Dim OutMail As Object
    
    imgRNG = "A1:I13"

    'Create a new Microsoft Outlook session
    Set OutApp = CreateObject("outlook.application")
            
    'create a new message
    Set OutMail = OutApp.CreateItem(0)
            
    With OutMail
        .Subject = "Insert Subject here"
        .HTMLBody = "<span LANG=EN>" & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
        & "Hello,<br><br>Insert message here, use for next line"
    
        Call createJpg("Email", imgRNG, "MailAttach") 'Worksheet name
            
        TempFilePath = Environ$("temp") & "\"
        .Attachments.Add TempFilePath & "MailAttach.jpg", 0, 0
            
        'Then we add an html <img src=''> link to this image
        .HTMLBody = .HTMLBody & "<br><B>Image:</B><br><br>" _
        & "<img src='cid:MailAttach.jpg'<br>" & _
        "<br>Best Regards,<br>Someone</font></span>"

        .To = "contact1@email.com; contact2@email.com"
        .Cc = "contact3@email.com"
        .Display
        '.Send
    End With
        
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

post and file here
viewing my range as a jpg and send via email

 

[andrewb90]

I don't want an image of the cell range. I'd like the cell contents to be copied into the body of the email.

 

[humdingaling]

i would of thought maintaining formatting would be the issue when pasting ranges

anyway
wouldn't you just need to add to variable to body in the loop

paste your code for how your looping thru each address and i can see how this can be added

 

[andrewb90]

Here it is:

'This module will contain the emailing functions
Sub E_FOH() ' this still needs to custom show the row range 3/6/16
  Dim r As Range, c As Range
  Dim sTo As String, ppdf As String, pdf As String, p As String
  
  'Path PDF
  'ppdf = ThisWorkbook.Path
  ppdf = Worksheets("Settings").Range("C3").Value2
  If Right(ppdf, 1) <> "\" Then ppdf = ppdf & "\"
  
  'PDF filename
  p = Worksheets("Settings").Range("C5")
  ' p = Worksheets("Print").Range("D1").Value2 & " " & _
 '   Replace(Worksheets("Scheduler").Range("H84").Text, "/", "-")
  pdf = ppdf & p & ".pdf"
  'Debug.Print pdf
  Sheets("Print").Visible = True
  Sheets("Print").Select
  Application.Run "module2.HideFOH"
  'Call HideFOH
  'Make PDF no need for range - just hide cells based on which sheet FOH,BOH, you want to send
  PublishToPDF pdf, Worksheets("Print") '.Range("D1:AB30")
  'Set range for FOH
  Set r = Worksheets("Employees").Range("K6:L42")
  For Each c In r
    With c
      If InStr(.Value2, "@") <> 0 Then sTo = sTo & "," & .Value2
    End With
  Next c
  
  If sTo = "" Then
    MsgBox sTo, vbCritical, "Ending Macro - Missing email(s)"
    Exit Sub
  End If
  
  sTo = Right(sTo, Len(sTo) - 1)
  'This is the split for putting a custom message instead of the default message
If Sheets("Settings").Range("c12").Value = "test" Then
  Gmail "zzz@gmail.com", "1234", "", _
    "o> " & vbNewLine & "Here is the upcoming schedule, updated as of " & Now & vbNewLine & "Regards," & vbNewLine & "Schedule Master Zax" & vbNewLine & "" & vbNewLine & "" & vbNewLine & "Please do not respond to this message, replies will be fed to the chickens.", _
    sTo, _
    "1@2.3", _
    pdf
Else
  Gmail "zzz@gmail.com", "1234", "", _
    "o> " & vbNewLine & "Here's the upcoming schedule and a special message from " & Sheets("Custom").Range("C4").Value & vbNewLine & "Regards," & vbNewLine & "Schedule Master Zax" & vbNewLine & "" & vbNewLine & Sheets("Custom").Range("C5").Value & vbNewLine & "- " & Sheets("Custom").Range("C4") & vbNewLine & "" & vbNewLine & "Please do not respond to this message, replies will be fed to the chickens.", _
    sTo, _
    "1@2.3", _
    pdf
End If
    
MsgBox "All Done"
End Sub

 

[humdingaling]

ok i so ran thru your code...going to have to make a few assumptions

you have 3 seperate other subroutines within the code
going to stab in the dark what they do

hideFOH - hiding stuff
PublishToPDF - make pdf
Gmail - determines how the CDO email is made (im guessing your using something like this CDO Sending mail from Excel with CDO)

after looking at the code, i need to understand exactly what you mean but this

All the emails need the range Print!D1:AB4, however each row on the email list would get a row just for them K6:L6 would get Print!D6:AB6, and so on so forth down the sheet.

so say you have 3 rows of email in employees!K6:L8
so first row = K6:L6 = PRINT!D1:AB4 + PRINT!D5:AB5
second row = K7:L7 = PRINT!D1:AB4 + PRINT!D6:AB6
3rd row = K8:L8 = PRINT!D1:AB4 + PRINT!D7:AB7
.......
and this goes into publish To PDF?

doesnt look like there is any cell range into Body of email

 

[andrewb90]

so say you have 3 rows of email in employees!K6:L8
so first row = K6:L6 = PRINT!D1:AB4 + PRINT!D5:AB5
second row = K7:L7 = PRINT!D1:AB4 + PRINT!D6:AB6
3rd row = K8:L8 = PRINT!D1:AB4 + PRINT!D7:AB7

You are correct except the second set of data starts at row 6, then 7, then 8 (not D5,D6,D7)

I don't want this data to go to pdf, I'd like it to go as the body of the email. I'll probably leave the rest as an attachment for now, but I'd like the individual schedules to show up in the body, as attachments are causing me some problems at the moment.

And yes, your stab in the dark was a direct hit!

 

[humdingaling]

ok that is fine you can fine tune it yourself later

what i first suggest you do is to take the body out and focus on it seperate

If Sheets("Settings").Range("c12").Value = "test" Then
    strBody = vbNewLine & "Here is the upcoming schedule, updated as of " & Now & vbNewLine & "Regards," & vbNewLine & "Schedule Master Zax" & vbNewLine & "" & vbNewLine & "" & vbNewLine & "Please do not respond to this message, replies will be fed to the chickens."
Else
    strBody = vbNewLine & "Here's the upcoming schedule and a special message from " & Sheets("Custom").Range("C4").Value & vbNewLine & "Regards," & vbNewLine & "Schedule Master Zax" & vbNewLine & "" & vbNewLine & Sheets("Custom").Range("C5").Value & vbNewLine & "- " & Sheets("Custom").Range("C4") & vbNewLine & "" & vbNewLine & "Please do not respond to this message, replies will be fed to the chickens."
End If

Gmail "zzz@gmail.com", "1234", "", "o> " & strBody, sTo, "1@2.3", pdf

something like this

then strbody can then be added to based on the amount of rows you have in employees!K6:L8

 

[andrewb90]

Ok, I'm not exactly following you on this.

then strbody can then be added to based on the amount of rows you have in employees!K6:L8

Sorry, i'm just not sure what this is doing?

 

[humdingaling]

    If Sheets("Settings").Range("c12").Value = "test" Then
        strbody = vbNewLine & "Here is the upcoming schedule, updated as of " & Now & vbNewLine & "Regards," & vbNewLine & "Schedule Master Zax" & vbNewLine & "" & vbNewLine & "" & vbNewLine & "Please do not respond to this message, replies will be fed to the chickens."
    Else
        strbody = vbNewLine & "Here's the upcoming schedule and a special message from " & Sheets("Custom").Range("C4").Value & vbNewLine & "Regards," & vbNewLine & "Schedule Master Zax" & vbNewLine & "" & vbNewLine & Sheets("Custom").Range("C5").Value & vbNewLine & "- " & Sheets("Custom").Range("C4") & vbNewLine & "" & vbNewLine & "Please do not respond to this message, replies will be fed to the chickens."
    End If
    
    i = Application.WorksheetFunction.CountA(Worksheets("Employees").Range("K6:K42"))
    Set rng = Worksheets("print").Range("D6:AB" & 5 + i)
    
    
    For Each c In rng
        strPrint = strPrint & c.Value2
    
    Next
    
    MsgBox strbody & vbNewLine & strPrint

made
i = using the amount of rows found in employee email range

create new range of Print!D6:AB 5+i
if i = 3 is found it would =Print!D6:AB8

to be honest i have not really used CDO before so i really only know outlook syntax
however i believe the basis is similar...i think it just wont look the way you may want to?

anyway i put a msgbox at the end which should be your email body