Consulting

Results 1 to 1 of 1

Thread: Add Checkboxes that will return emails addresses in the BCC field into Outlook

  1. #1

    Add Checkboxes that will return emails addresses in the BCC field into Outlook

    I need help

    I am building an email in Excel for Outlook using the following code:

    Sub Mail_Selection_Range_Outlook_Body()
        'Don't forget to copy the function RangetoHTML in the module.
        'Working in Excel 2000-2016
            Dim rng As Range
            Dim OutApp As Object
            Dim OutMail As Object
    
            Set rng = Nothing
            On Error Resume Next
            'Only the visible cells in the selection
            'Set rng = Selection.SpecialCells(xlCellTypeVisible)
            'You can also use a fixed range if you want
            Set rng = Sheets("Volume Template").Range("K4:L14").SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
    
            If rng Is Nothing Then
                MsgBox "The selection is not a range or the sheet is protected" & _
                       vbNewLine & "please correct and try again.", vbOKOnly
                Exit Sub
            End If
    
            With Application
                .EnableEvents = False
                .ScreenUpdating = False
            End With
    
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
    
            On Error Resume Next
            With OutMail
                .To = ""
                .CC = ""
                .BCC =
                .Subject = "UTS VOLUME QUOTE REQUEST"
                .HTMLBody = RangetoHTML(rng)
                .Display   'or use .Send
            End With
            On Error GoTo 0
    
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
    
            Set OutMail = Nothing
            Set OutApp = Nothing
        End Sub
    
    
        Function RangetoHTML(rng As Range)
            Dim fso As Object
            Dim ts As Object
            Dim TempFile As String
            Dim TempWB As Workbook
    
            TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    
            'Copy the range and create a new workbook to past the data in
            rng.Copy
            Set TempWB = Workbooks.Add(1)
            With TempWB.Sheets(1)
                .Cells(1).PasteSpecial Paste:=8
                .Cells(1).PasteSpecial xlPasteValues, , False, False
                .Cells(1).PasteSpecial xlPasteFormats, , False, False
                .Cells(1).Select
                Application.CutCopyMode = False
                On Error Resume Next
                .DrawingObjects.Visible = True
                .DrawingObjects.Delete
                On Error GoTo 0
            End With
    
            'Publish the sheet to a htm file
            With TempWB.PublishObjects.Add( _
                 SourceType:=xlSourceRange, _
                 Filename:=TempFile, _
                 Sheet:=TempWB.Sheets(1).Name, _
                 Source:=TempWB.Sheets(1).UsedRange.Address, _
                 HtmlType:=xlHtmlStatic)
                .Publish (True)
            End With
    
            'Read all data from the htm file into RangetoHTML
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
            RangetoHTML = ts.readall
            ts.Close
            RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                                  "align=left x:publishsource=")
    
            'Close TempWB
            TempWB.Close savechanges:=False
    
            'Delete the htm file we used in this function
            Kill TempFile
    
            Set ts = Nothing
            Set fso = Nothing
            Set TempWB = Nothing
        End Function
    I want to use check boxes (using the form controls) to decide whether an email is used.

    If the check box reference cell is true input the value of a cell (an email address) into the BCC field.

    If Cell H4=True return Cell F4.

    Going down a list of about 30 entries so this needs to loop until there are no more check boxes

    How do I write this code?
    Last edited by Tommy; 03-06-2017 at 08:32 AM. Reason: Added code tags

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •