Create email addressee list based on checkbox ticked or not

[sndr]

I want to send out to a specific mail if a checkbox has been ticked.
Got 5 choices that can be ticked (or not).
If pressed OK, I want to generate automatically the emailaddresses of the ticked checkboxes (have the vba to send via outlook).
Can anybody please help?
Should I include the vba I have now?
Thanx

[ragavan.sridar1]

try this...

Please Login or Register  to view this content.

[sndr]

Thank you for your tip!
But this will not do the trick I'm affraid.
It will have to do something like for each checkbox.value = true add to emaillist, and then this emaillist will have to go into arg1.
Herewith my code, missing piece as of "RFQTo.show":

Private Sub MailRFQ_Click()

Dim wbThis As Workbook
Dim wbNew As Workbook
Dim sh As Worksheet
Dim cb As Control
Dim RFQno As String
Dim controltiptext As String
Dim Tolist As Boolean

Set wbThis = ThisWorkbook
RFDno = Sheets("Tender Details").Range("Tender_RFDno")

RFQCombination.Show

'Tick boxes
For Each cb In RFQCombination.Controls
If cb.Value = False Then
Else
Worksheets(cb.Caption).Select Replace:=False
End If
Next cb

ActiveWindow.SelectedSheets.Copy
Set wbNew = ActiveWorkbook
For Each sh In wbNew.Worksheets
sh.Activate
sh.Unprotect Password:="access19"
sh.Cells.Select
sh.Cells.Copy
sh.Cells.PasteSpecial xlValues
sh.Shapes.SelectAll
Selection.Delete
Rows("17:18").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
sh.Range("A1").Select
sh.Protect Password:="access19", DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowSorting _
:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Next sh

With ActiveWorkbook
.SaveAs FileName:=Application.GetSaveAsFilename(wbThis.Path & "\RFQ_RFD" & RFDno & ".xlsx")

RFQTo.Show

For Each cb In RFQTo.Controls
If cb.Value = True Then
Tolist(cb.Caption).Value.Add
End If
Next cb

Application.Dialogs(xlDialogSendMail).Show arg1:=Tolist, _
arg2:="RFQ: " & ActiveCell.Range("A1").Value
.Close SaveChanges:=True

End With

wbThis.Activate

RFQChoices.Hide

End Sub

[sndr]

Found it and works like a charm !


Private Sub MailRFQ_Click()

Dim wbThis As Workbook
Dim wbNew As Workbook
Dim sh As Worksheet
Dim cb As Control
Dim RFQno As String
Dim controltiptext As String
Dim Tolist As Boolean

Set wbThis = ThisWorkbook
RFDno = Sheets("Tender Details").Range("Tender_RFDno")

RFQCombination.Show

'Tick boxes
For Each cb In RFQCombination.Controls
If cb.Value = False Then
Else
Worksheets(cb.Caption).Select Replace:=False
End If
Next cb

ActiveWindow.SelectedSheets.Copy
Set wbNew = ActiveWorkbook
For Each sh In wbNew.Worksheets
sh.Activate
sh.Unprotect Password:="access19"
sh.Cells.Select
sh.Cells.Copy
sh.Cells.PasteSpecial xlValues
sh.Shapes.SelectAll
Selection.Delete
Rows("17:18").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
sh.Range("A1").Select
sh.Protect Password:="access19", DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowSorting _
:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Next sh

With ActiveWorkbook
.SaveAs FileName:=Application.GetSaveAsFilename(wbThis.Path & "\RFQ_RFD" & RFDno & ".xlsx")

RFQTo.Show

Dim x As Integer
Dim ctrl As Control
Dim myArray() As String
x = 1
For Each ctrl In RFQTo.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl.Value = True Then
x = x + 1
ReDim Preserve myArray(x)
myArray(x) = ctrl.Caption
End If
End If
Next

Application.Dialogs(xlDialogSendMail).Show arg1:=myArray(), _
arg2:="RFQ: " & ActiveCell.Range("A1").Value
.Close SaveChanges:=True

End With

wbThis.Activate

RFQChoices.Hide

End Sub