Combine 2 VBA/CDO codes into one

[andrewb90]

Hello All,

I have two independently successful codes. the first is a CDO to send a pdf attachment of a cell range to all email address within a specified cell range.

The other is a code that puts individual cell values into a message box. Each row on my list of emails gets different rows so that essentially every employee gets their unique schedule in the body of the email, while the larger schedule is sent as an attachment.

Here is the CDO:

'This module will contain the emailing functionsSub E_FOH() ' this still needs to custom show the row range to only show the FOH schedule 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("Sheet1").Range("C4:D12") '*** This range has 9 different emails up to 2 per row(employee)
  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
  
  
[COLOR=#ff0000]If Sheets("Settings").Range("c12").Value = "test" Then[/COLOR]
[COLOR=#ff0000]  Gmail "zzz@gmail.com", "12345", "", _[/COLOR]
[COLOR=#ff0000]    "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.", _[/COLOR]
[COLOR=#ff0000]    sTo, _[/COLOR]
[COLOR=#ff0000]    "1@2.3", _[/COLOR]
[COLOR=#ff0000]    pdf[/COLOR]
[COLOR=#ff0000]Else[/COLOR]
[COLOR=#ff0000]  Gmail "zzz@gmail.com", "12345", "", _[/COLOR]
[COLOR=#ff0000]    "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.", _[/COLOR]
[COLOR=#ff0000]    sTo, _[/COLOR]
[COLOR=#ff0000]    "1@2.3", _[/COLOR]
[COLOR=#ff0000]    pdf[/COLOR]
[COLOR=#ff0000]End If[/COLOR]
    
MsgBox "All Done"
End Sub

The red section of the code would need to be updated so that instead of having only the standard text, It would also have the unique schedule that would go to each employee...see the next code:

Sub individual()Dim rng1, rng2, i As Integer
    
    rng1 = Worksheets("Sheet1").Range("C4:D12").Value
    rng2 = Worksheets("Sheet2").Range("G2:AG10").Value
    
    For i = 1 To UBound(rng1, 1)
        If rng1(i, 1) & rng1(i, 2) <> "" Then
          MsgBox Prompt:="Here is this weeks schedule: " & Chr(10) & _
            "Monday" & " " & rng2(i, 1) & " " & rng2(i, 2) & " " & rng2(i, 3) & " " & rng2(i, 4) & Chr(10) & _
            "Tuesday" & " " & rng2(i, 5) & " " & rng2(i, 6) & " " & rng2(i, 7) & " " & rng2(i, 8) & Chr(10) & _
            "Wednesday" & " " & rng2(i, 9) & " " & rng2(i, 10) & " " & rng2(i, 11) & " " & rng2(i, 12) & Chr(10) & _
            "Thursday" & " " & rng2(i, 13) & " " & rng2(i, 14) & " " & rng2(i, 15) & " " & rng2(i, 16) & Chr(10) & _
            "Friday" & " " & rng2(i, 17) & " " & rng2(i, 18) & " " & rng2(i, 19) & " " & rng2(i, 20) & Chr(10) & _
            "Saturday" & " " & rng2(i, 21) & " " & rng2(i, 22) & " " & rng2(i, 23) & " " & rng2(i, 24) & Chr(10) & _
            "Sunday" & " " & rng2(i, 25) & " " & rng2(i, 26) & " " & rng2(i, 27) & " " & rng2(i, 28) & Chr(10), _
            Title:="Sheet1 C" & i + 3 & ": " & rng1(i, 1) & "; D" & i + 3 & ": " & rng1(i, 2)
        End If
    Next i
End Sub

I don't actually need the message box, it was just useful for testing.

Any help and/or guidance would be greatly appreciated. It's been a long project, and hopefully I'm getting close to having it work the way I've wanted.

 

[baitmaster]

turn the sub into a function that returns a string

Function strIndividual() as String
Dim rng1, rng2, i As Integer
rng1 = Worksheets("Sheet1").Range("C4:D12").Value
rng2 = Worksheets("Sheet2").Range("G2:AG10").Value
    
    For i = 1 To UBound(rng1, 1)
        If rng1(i, 1) & rng1(i, 2) <> "" Then
          strIndividual="Here is this weeks schedule: " & Chr(10) & _
            "Monday" & " " & rng2(i, 1) & " " & rng2(i, 2) & " " & rng2(i, 3) & " " & rng2(i, 4) & Chr(10) & _
            "Tuesday" & " " & rng2(i, 5) & " " & rng2(i, 6) & " " & rng2(i, 7) & " " & rng2(i, 8) & Chr(10) & _
            "Wednesday" & " " & rng2(i, 9) & " " & rng2(i, 10) & " " & rng2(i, 11) & " " & rng2(i, 12) & Chr(10) & _
            "Thursday" & " " & rng2(i, 13) & " " & rng2(i, 14) & " " & rng2(i, 15) & " " & rng2(i, 16) & Chr(10) & _
            "Friday" & " " & rng2(i, 17) & " " & rng2(i, 18) & " " & rng2(i, 19) & " " & rng2(i, 20) & Chr(10) & _
            "Saturday" & " " & rng2(i, 21) & " " & rng2(i, 22) & " " & rng2(i, 23) & " " & rng2(i, 24) & Chr(10) & _
            "Sunday" & " " & rng2(i, 25) & " " & rng2(i, 26) & " " & rng2(i, 27) & " " & rng2(i, 28) & Chr(10)
        End If
    Next i
End Sub

then just call the function when required. I think you'll need to pull the rng1/2 declarations outside of the function, and pass the values in like

Function strIndividual(rng1 as range, rng2 as range) as String

so you'll have to change the message accordingly

Also, note that in Outlook the message is in HTML so instead of Chr(10) you'll probably need to use the html equivalent, "<br>"

 

[baitmaster]

* open triangular bracket, "br", close triangular bracket
if you actually write it on the forum, it gets interpreted as HTML and you don't see it, as per my last post...

 

[andrewb90]

I will try putting this together and I will reply back later tonight with the results. I'm pretty sure I know what you are thinking I should do, I just want to make sure I can pull it off successfully!

 

[andrewb90]

Ok, so I have the function saved in the same module, but I get errors when I try to call it. What else am I supposed to add to my code?