Creating multiple emails for multiple addresses

[andrewb90]

Hello All,


I have been using CDO to email pdf attachments to my employees, and for the most part it has been successful. I now am facing two different issues I am hoping to get some assistance with.

The first is that a majority of the emails that I send are email to texts, where I have a phone number and a wireless carrier, and the carrier supplied email address, and then the email can be received as a text with an attachment (sms/mms). The problem us that about half of the recipients only receive the text and not the attachment, and others receive nothing at all (yet the lucky half gets everything) All standard emails receive it with no hiccups.

Are there any possible solutions to fix this?

One solution that I can up with, is one that I need some assistance with. I figured instead of sending a pdf section of cells to a particular email or two could I make the message body a cell range? The challenge is that each employee can have two contact emails (text & standard) and I would like to send their unique schedule to them.

Here is the primary portion of the emailing code. Any help would be wonderful.

- Andrew

Sub E_Prep()  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
  Rows("5:56").Hidden = True
  Rows("57:65").Hidden = False
  Rows("66:76").Hidden = True
  Application.Run "module2.HidePrep"
  '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("K58:L65")
  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 "myEmail@email.com", "mySecretPassword", "", _
    "o> " & vbNewLine & "Here is the upcoming schedule, updated as of " & Now & vbNewLine & "Regards," & vbNewLine & "Scheduler." & vbNewLine & "" & vbNewLine & "" & vbNewLine & "Please do not respond to this message.", _
    sTo, _
    "1@2.3", _
    pdf
Else
  Gmail "myEmail@email.com", "mySecretPassword", "", _
    "o> " & vbNewLine & "Here's the upcoming schedule and a special message from " & Sheets("Custom").Range("C4").Value & vbNewLine & "Regards," & vbNewLine & "Scheduler" & vbNewLine & "" & vbNewLine & Sheets("Custom").Range("C5").Value & vbNewLine & "- " & Sheets("Custom").Range("C4") & vbNewLine & "" & vbNewLine & "Please do not respond to this message.", _
    sTo, _
    "1@2.3", _
    pdf
End If
    
MsgBox "All Done"
End Sub

 

[andrewb90]

Bump^

 

[andrewb90]

Bump#2^