Code to Email Specific People Based on ComboBox Selection

**esanvilla** · 02-19-2015, 10:07 AM

Hello. When I introduced myself in this forum, I mentioned that I am an amateur. This code shows why I said that.

The code allows me to select a person from a combobox and then press one of several buttons listed below:
1. Save as PDF
2. Save All as PDF
3. Send PDF to the person
4. Send PDF to the persons manager
5. Send PDF to both people
6. Send all people their individual PDF
7. Send all people and their managers their PDF

I got this all to work, but I know that the way I coded it will be hard to maintain. Can anybody suggest a better way?

Private Sub EmailSGA_Click()

'--------------------------------This code will email the spreadsheet to the selected Person only-----------------------------------------------------------------------
  
  If MsgBox("Converting your file to pdf and emailing to the SGA. Would you like to continue? Select 'Yes' or 'No'", vbYesNo, "Continue?") = vbNo Then Exit Sub

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim sTo As String
  Dim newFile As String
  
  Title = Range("D2")

      If Sheets("2015 SHIFT").Range("D2") = "PERSON1" Then
           sTo = "PERSON1@ANYWHERE.COM; PERSON1CO-OWNER@ANYWHERE.COM"
           
           ElseIf Sheets("2015 SHIFT").Range("D2") = "PERSON2" Then
           sTo = "PERSON2@ANYWHERE.COM"
           
           ElseIf Sheets("2015 SHIFT").Range("D2") = "PERSON3" Then
           sTo = "PERSON3@ANYWHERE.COM"

          '......... 62 more people!
           Else
            MsgBox ("Invalid SGA. Email not sent.")
            
       End If
       
    PdfFile = ActiveWorkbook.FullName
    
        i = InStrRev(PdfFile, ".")
        If i > 1 Then PdfFile = Left(PdfFile, i - 1)
        PdfFile = PdfFile & "_" & Title & "_" & Format$(Date, "mm-dd-yyyy") & ".pdf"
        
            With ActiveSheet
              .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End With
    
        On Error Resume Next
        Set OutlApp = GetObject(, "Outlook.Application")
        
        If Err Then
          Set OutlApp = CreateObject("Outlook.Application")
          IsCreated = True
        End If
        
        OutlApp.Visible = True
        On Error GoTo 0
        
     With OutlApp.CreateItem(0)
      
       .Subject = Title & " " & Format$(Date, "mm-dd-yyyy")
       .To = sTo ' <-- Put email of the recipient here
       .CC = "krcurtis@ailife.com" ' <-- Put email of 'copy to' recipient here
       .Body = "Hello," & vbLf & vbLf _
             & "I have attached the 2015 SGA Shift Tracker for the current month." & vbLf & vbLf _
             & "Regards," & vbLf _
             & Application.UserName & vbLf & vbLf
       .Attachments.Add PdfFile
       '.Importance = 2
      
       On Error Resume Next
       .Send
       Application.Visible = True
       If Err Then
         MsgBox "E-mail was not sent", vbExclamation
       'Else
         'MsgBox "E-mail successfully sent", vbInformation
       End If
       On Error GoTo 0
      
     End With

        Kill PdfFile
        If IsCreated Then OutlApp.Quit
        Set OutlApp = Nothing
        
    MsgBox ("Your converted file has been emailed to:" & " " & sTo)
         
End Sub


Private Sub EmailAll_Click()

'--------------------------------This code will email all People their individual spreadsheet as a PDF-----------------------------------------------------------------------

  If MsgBox("Converting all files to pdf and emailing to the proper SGA. Would you like to continue? Select 'Yes' or 'No'", vbYesNo, "Continue?") = vbNo Then Exit Sub

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim sTo As String

  Dim newFile As String
  Dim intComboItem As Integer
  
  Me.ComboBox1.ListIndex = 0
  Sheets("2015 SHIFT").Range("D2") = ComboBox1.Value
        
  For intComboItem = 0 To Me.ComboBox1.ListCount - 1
  Sheets("2015 SHIFT").Range("D2") = Me.ComboBox1.List(intComboItem)
  
  Title = Range("D2")
 
 
      If Sheets("2015 SHIFT").Range("D2") = "PERSON1" Then
           sTo = "PERSON1@ANYWHERE.COM; PERSON1CO-OWNER@ANYWHERE.COM"
           
           ElseIf Sheets("2015 SHIFT").Range("D2") = "PERSON2" Then
           sTo = "PERSON2@ANYWHERE.COM"
           
           ElseIf Sheets("2015 SHIFT").Range("D2") = "PERSON3" Then
           sTo = "PERSON3@ANYWHERE.COM"

          '......... 62 more people!
           Else
            MsgBox ("Invalid SGA. Email not sent.")
            
       End If
    
            PdfFile = ActiveWorkbook.FullName
            i = InStrRev(PdfFile, ".")
            If i > 1 Then PdfFile = Left(PdfFile, i - 1)
            PdfFile = PdfFile & "_" & Title & "_" & Format$(Date, "mm-dd-yyyy") & ".pdf"
            
            With ActiveSheet
              .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End With

         On Error Resume Next
         Set OutlApp = GetObject(, "Outlook.Application")
         If Err Then
           Set OutlApp = CreateObject("Outlook.Application")
           IsCreated = True
         End If
         OutlApp.Visible = True
         On Error GoTo 0
        
         With OutlApp.CreateItem(0)
         
           .Subject = Title & " " & Format$(Date, "mm-dd-yyyy")
           .To = sTo ' <-- Put email of the recipient here
           .CC = "krcurtis@ailife.com" ' <-- Put email of 'copy to' recipient here
           .Body = "Hello," & vbLf & vbLf _
                 & "I have attached the 2015 SGA Shift Tracker for the current month." & vbLf & vbLf _
                 & "Regards," & vbLf _
                 & Application.UserName & vbLf & vbLf
           .Attachments.Add PdfFile
           '.Importance = 2

           On Error Resume Next
           .Send
           Application.Visible = True
           If Err Then
             MsgBox "E-mail was not sent", vbExclamation
           'Else
             'MsgBox "E-mail successfully sent", vbInformation
           End If
           On Error GoTo 0
          
         End With

         Kill PdfFile
         If IsCreated Then OutlApp.Quit
         Set OutlApp = Nothing

Next
                
Me.ComboBox1.ListIndex = 0
Sheets("2015 SHIFT").Range("D2") = ComboBox1.Value

MsgBox ("Your converted files have been emailed")
        
        
End Sub

Private Sub SaveBtn_Click()

'--------------------This code will Save the selected Peoples spreadsheet as a PDF to your location of choosing------------------------------------------------------

Worksheets("2015 SHIFT").Range("D2") = ComboBox1.Value
Dim v As Variant
fName = Range("D2").Value
v = Application.GetSaveAsFilename("2015 Shift Tracker" & "_" & fName & "_" & Format$(Date, "mm-dd-yyyy"), "PDF Files (*.pdf), *.pdf")

If VarType(v) = vbString Then
ThisWorkbook.ExportAsFixedFormat xlTypePDF, Filename:=v, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=True
End If

End Sub


Private Sub SaveAll_Click()

'--------------------This code will Save every Persons spreadsheet as a PDF in C:\Users\Default\My Documents------------------------------------------------------

        If MsgBox("Saving every SGA as an individual PDF file. Would you like to continue? Select 'Yes' or 'No'", vbYesNo, "Continue?") = vbNo Then Exit Sub

        ChDrive ("C:\")
        ChDir ("C:\Users\Default\My Documents")
        
        Dim i As Integer
        Dim newFile As String
        Dim intComboItem As Integer
        
        Sheets("2015 SHIFT").Range("D2") = Me.ComboBox1.List(intComboItem)
        
        For intComboItem = 0 To Me.ComboBox1.ListCount - 1
        
        'On Error GoTo ErrHandler:
        
        Sheets("2015 SHIFT").Range("D2") = Me.ComboBox1.List(intComboItem)
        fName = Range("D2").Value
        newFile = fName & "_" & Format$(Date, "mm-dd-yyyy")
        ThisWorkbook.ExportAsFixedFormat xlTypePDF, Filename:=newFile
        fName = ""
        newFile = ""
        
        Next
                
'ErrHandler:
        'MsgBox ("An error occurred in the VBA code.")
'Resume Next
                
        Me.ComboBox1.ListIndex = 0
        Sheets("2015 SHIFT").Range("D2") = ComboBox1.Value
        MsgBox ("All files have been saved in the following path C:\Users\Default\My Documents. You may have to select view hidden files.")
        

End Sub



Private Sub SendAllBoth_Click()

'---------------This code will email all People their individual spreadsheet as a PDF and it will copy their Manager-----------------------------------------------------------------------

  If MsgBox("Converting all files to pdf and emailing to the proper SGA. Would you like to continue? Select 'Yes' or 'No'", vbYesNo, "Continue?") = vbNo Then Exit Sub

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim sTo As String
  Dim ccTo As String
  Dim newFile As String
  Dim intComboItem As Integer
  
  Me.ComboBox1.ListIndex = 0
  Sheets("2015 SHIFT").Range("D2") = ComboBox1.Value
        
  For intComboItem = 0 To Me.ComboBox1.ListCount - 1
  Sheets("2015 SHIFT").Range("D2") = Me.ComboBox1.List(intComboItem)
  
  Title = Range("D2")
 
 
      If Sheets("2015 SHIFT").Range("D2") = "PERSON1" Then
           sTo = "PERSON1@ANYWHERE.COM; PERSON1CO-OWNER@ANYWHERE.COM"
           
           ElseIf Sheets("2015 SHIFT").Range("D2") = "PERSON2" Then
           sTo = "PERSON2@ANYWHERE.COM"
           ccTo= "PERSON2MANAGER@ANYWHERE.COM
           
           ElseIf Sheets("2015 SHIFT").Range("D2") = "PERSON3" Then
           sTo = "PERSON3@ANYWHERE.COM"
           ccTo= "PERSON3MANAGER@ANYWHERE.COM

          '......... 62 more people!
           Else
            MsgBox ("Invalid SGA. Email not sent.")            
       End If
    
            PdfFile = ActiveWorkbook.FullName
            i = InStrRev(PdfFile, ".")
            If i > 1 Then PdfFile = Left(PdfFile, i - 1)
            PdfFile = PdfFile & "_" & Title & "_" & Format$(Date, "mm-dd-yyyy") & ".pdf"
            
            With ActiveSheet
              .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End With
        
         On Error Resume Next
         Set OutlApp = GetObject(, "Outlook.Application")
         If Err Then
           Set OutlApp = CreateObject("Outlook.Application")
           IsCreated = True
         End If
         OutlApp.Visible = True
         On Error GoTo 0
        
         With OutlApp.CreateItem(0)
          
           .Subject = Title & " " & Format$(Date, "mm-dd-yyyy")
           .To = sTo ' <-- Put email of the recipient here
           .CC = ccTo & "; " & "krcurtis@ailife.com" '<-- Put email of 'copy to' recipient here
           .Body = "Hello," & vbLf & vbLf _
                 & "I have attached the 2015 SGA Shift Tracker for the current month." & vbLf & vbLf _
                 & "Regards," & vbLf _
                 & Application.UserName & vbLf & vbLf
           .Attachments.Add PdfFile
           '.Importance = 2
          
           On Error Resume Next
           .Send
           Application.Visible = True
           If Err Then
             MsgBox "E-mail was not sent", vbExclamation
           'Else
             'MsgBox "E-mail successfully sent", vbInformation
           End If
           On Error GoTo 0
          
         End With
        
         Kill PdfFile
         If IsCreated Then OutlApp.Quit
         Set OutlApp = Nothing

Next
                
Me.ComboBox1.ListIndex = 0
Sheets("2015 SHIFT").Range("D2") = ComboBox1.Value

MsgBox ("Your converted files have been emailed")


End Sub

**esanvilla** · 02-19-2015, 10:08 AM

I had to split it up.

Private Sub SendBoth_Click()

'------This code will email the selected Person their individual spreadsheet as a PDF and it will copy their Manager-----------------------------------------------------------------------

  If MsgBox("Converting your file to pdf and emailing to the SGA and their Director. Would you like to continue? Select 'Yes' or 'No'", vbYesNo, "Continue?") = vbNo Then Exit Sub

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim sTo As String
  Dim ccTo As String
  Dim newFile As String
  
  Title = Range("D2")

      If Sheets("2015 SHIFT").Range("D2") = "PERSON1" Then
           sTo = "PERSON1@ANYWHERE.COM; PERSON1CO-OWNER@ANYWHERE.COM"
           
           ElseIf Sheets("2015 SHIFT").Range("D2") = "PERSON2" Then
           sTo = "PERSON2@ANYWHERE.COM"
           ccTo= "PERSON2MANAGER@ANYWHERE.COM
           
           ElseIf Sheets("2015 SHIFT").Range("D2") = "PERSON3" Then
           sTo = "PERSON3@ANYWHERE.COM"
           ccTo= "PERSON3MANAGER@ANYWHERE.COM

          '......... 62 more people!
           Else
            MsgBox ("Invalid SGA. Email not sent.")                
       End If
       
            PdfFile = ActiveWorkbook.FullName
            i = InStrRev(PdfFile, ".")
            If i > 1 Then PdfFile = Left(PdfFile, i - 1)
            PdfFile = PdfFile & "_" & Title & "_" & Format$(Date, "mm-dd-yyyy") & ".pdf"
            
            With ActiveSheet
              .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End With
        
         On Error Resume Next
         Set OutlApp = GetObject(, "Outlook.Application")
         If Err Then
           Set OutlApp = CreateObject("Outlook.Application")
           IsCreated = True
         End If
         OutlApp.Visible = True
         On Error GoTo 0
        
         With OutlApp.CreateItem(0)
          
           .Subject = Title & " " & Format$(Date, "mm-dd-yyyy")
           .To = sTo ' <-- Put email of the recipient here
           .CC = ccTo & "; " & "krcurtis@ailife.com" '<-- Put email of 'copy to' recipient here
           .Body = "Hello," & vbLf & vbLf _
                 & "I have attached the 2015 SGA Shift Tracker for the current month." & vbLf & vbLf _
                 & "Regards," & vbLf _
                 & Application.UserName & vbLf & vbLf
           .Attachments.Add PdfFile
           '.Importance = 2
          
           On Error Resume Next
           .Send
           Application.Visible = True
           If Err Then
             MsgBox "E-mail was not sent", vbExclamation
           'Else
             'MsgBox "E-mail successfully sent", vbInformation
           End If
           On Error GoTo 0
          
         End With
        
         Kill PdfFile
         If IsCreated Then OutlApp.Quit
         Set OutlApp = Nothing
         

         MsgBox ("Your converted file has been emailed to:" & " " & sTo & " " & ccTo & ".")


End Sub


Private Sub SendDir_Click()

'-----------------------This code will email the spreadsheet as a pdf to the selected Persons Manager----------------------------------------------------------------------

  If MsgBox("Converting your file to pdf and emailing to the SGA's Director. Would you like to continue? Select 'Yes' or 'No'", vbYesNo, "Continue?") = vbNo Then Exit Sub

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim sTo As String

  Dim newFile As String
  Title = Range("D2")

      If Sheets("2015 SHIFT").Range("D2") = "PERSON1" Then
           sTo = "PERSON1@ANYWHERE.COM; PERSON1CO-OWNER@ANYWHERE.COM"
           
           ElseIf Sheets("2015 SHIFT").Range("D2") = "PERSON2" Then
           sTo = "PERSON2@ANYWHERE.COM"
           
           ElseIf Sheets("2015 SHIFT").Range("D2") = "PERSON3" Then
           sTo = "PERSON3@ANYWHERE.COM"

          '......... 62 more people!
           Else
            MsgBox ("Invalid SGA. Email not sent.")
            
       End If
            
            PdfFile = ActiveWorkbook.FullName
            i = InStrRev(PdfFile, ".")
            If i > 1 Then PdfFile = Left(PdfFile, i - 1)
            PdfFile = PdfFile & "_" & Title & "_" & Format$(Date, "mm-dd-yyyy") & ".pdf"
            
            With ActiveSheet
              .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End With
        
         On Error Resume Next
         Set OutlApp = GetObject(, "Outlook.Application")
         If Err Then
           Set OutlApp = CreateObject("Outlook.Application")
           IsCreated = True
         End If
         OutlApp.Visible = True
         On Error GoTo 0
        
         With OutlApp.CreateItem(0)
          
           .Subject = Title & " " & Format$(Date, "mm-dd-yyyy")
           .To = sTo ' <-- Put email of the recipient here
           .CC = "krcurtis@ailife.com" ' <-- Put email of 'copy to' recipient here
           .Body = "Hello," & vbLf & vbLf _
                 & "I have attached the 2015 SGA Shift Tracker for the current month." & vbLf & vbLf _
                 & "Regards," & vbLf _
                 & Application.UserName & vbLf & vbLf
           .Attachments.Add PdfFile
           '.Importance = 2
          
           On Error Resume Next
           .Send
           Application.Visible = True
           If Err Then
             MsgBox "E-mail was not sent", vbExclamation
           'Else
             'MsgBox "E-mail successfully sent", vbInformation
           End If
           On Error GoTo 0
          
         End With
        
         Kill PdfFile
         If IsCreated Then OutlApp.Quit
         Set OutlApp = Nothing
         

         MsgBox ("Your converted file has been emailed to:" & " " & sTo)


End Sub

Private Sub Worksheet_Activate()