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
Bookmarks