Checkbox to remove recipient from bulk email

[FastFord]

I am creating a workbook where each worksheet represents Vacation Leave
Hours accrued for an employee. The Vacation information is updated
weekly and then I press a custom toolbar button that activates a macro
that emails each induvidual statement to that particular emloyee only.
The employee's email address is stored in b2. The employee's supervisor
also gets a copy so they can monitor how much vacation that their
employee(s) might be taking in the near future. There are approx 50
employees/worksheets. I created the macro by altering VBA code taken
from Ron DeBruin's website and it works very well.

Now I need to add checkboxes next to the two email addresses with a
note that if checked, the email address next to this checkbox is not to
recieve a copy of this worksheet during the bulk mailing. This will cut
down on the amount of mail in an inbox for an employee or supervisor
who does not care about the statement.

When I added CheckBox1 and CheackBox2 and the following code, I am
running into problems with people that are not supposed to recieve and
email still getting one, and everone recieves a copy of worksheet 1
instead of their own worksheet. Any suggestions would be appreciated.

-Joe

Here's what I have so far. I will also attach a sample called
3WACAP_Leave.xls


Sub Mail_Every_Worksheet()
Dim sh As Worksheet
Dim wb As Workbook
Application.ScreenUpdating = False
'loop through each wookbook
For Each sh In ThisWorkbook.Worksheets
sh.Copy
Set wb = ActiveWorkbook
With wb
Dim strdate As String
Dim firstName As String
strdate = Format(Now, "mm-dd-yy")
'Get the employee's first name from b2
firstName = sh.Range("b2").Value
..SaveAs firstName & "'s Leave Hours as of " & " " &
strdate & ".xls"
'check to see if this person wants a copy of the leave
statement
If wb.CheckBox1.Value = False Then
'send statement of leave to employee
..SendMail ActiveSheet.Range("e2").Value, _
firstName & "'s Leave Hours as of " & " " &
strdate
ElseIf wb.CheckBox1.Value = True Then
End If
'check to see if this person wants a copy of the leave
statement
If wb.CheckBox2.Value = False Then
'send copy to employee's supervisor
..SendMail ActiveSheet.Range("e5").Value, _
"Your employee " & firstName & "'s Leave Hours as
of " & " " & strdate
ElseIf wb.CheckBox2.Value = True Then
End If
..ChangeFileAccess xlReadOnly
Kill .FullName
..Close False
End With
Next sh
'end of loop
Application.ScreenUpdating = True
End Sub

 

[Ron de Bruin]

See other thread

 

[FastFord]

Ron,

Which other thread?

-Jo

 

[Ron de Bruin]

You posted the same question twice

I answered this
*******************************
I have not see the file but
Try this

Sub Mail_Every_Worksheet()
Dim sh As Worksheet
Dim wb As Workbook
Application.ScreenUpdating = False
'loop through each wookbook
For Each sh In ThisWorkbook.Worksheets
sh.Copy
Set wb = ActiveWorkbook
With wb
Dim strdate As String
Dim firstName As String
strdate = Format(Now, "mm-dd-yy")
'Get the employee's first name from b2
firstName = sh.Range("b2").Value
.SaveAs firstName & "'s Leave Hours as of " & " " & strdate & ".xls"
'check to see if this person wants a copy of the leave statement
If wb.Sheets(1).CheckBox1.Value = False Then
'send statement of leave to employee
.SendMail ActiveSheet.Range("e2").Value, _
firstName & "'s Leave Hours as of " & " " & strdate
End If
'check to see if this person wants a copy of the leave statement
If wb.Sheets(1).CheckBox2.Value = False Then
'send copy to employee's supervisor
.SendMail ActiveSheet.Range("e5").Value, _
"Your employee " & firstName & "'s Leave Hours as of " & " " & strdate
End If

.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Next sh
'end of loop
Application.ScreenUpdating = True
End Sub

 

[FastFord]

Ron,

Been meaning to get back to you. This code works perfectly.

Thanks,
Jo