Font of range

Andrew Walker
Andrew Walker used Ask the Experts™
on
I am using the following code which sends an email from excel to outlook
Sub Send_Email_Late()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Name_Lookup As String
    
  




    

    Set rng = Nothing
    Name_Lookup = ActiveSheet.Range("A3").Value
    
    
    On Error Resume Next
    'Only the visible cells in the selection
    'Set rng = Sheets("Sheet 1").Range("B2:B22").SpecialCells(xlCellTypeVisible)'
    'You can also use a fixed range if you want
    Set rng = Sheets("Stationary").Range("B1:O8").SpecialCells(xlCellTypeVisible)  ':B11
    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
        '.SentOnBehalfOfName = "sales@matthewclark.co.uk"
        .To = ActiveSheet.Range("Cs4").Value
        '.CC = Sheets("Email Data").Range("K2").Value'
        .BCC = ""
        .Subject = "Lateness Email - ENTER DATE"
        .HTMLBody = Name_Lookup & RangetoHTML(rng)
        .Display  'or use .Display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
'    MsgBox "The CS Form has successfully been sent to MC Customer Services.           A copy has been saved in your sent email folder.", vbInformation
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    
    
End Sub

Open in new window


The issue I am having is once the email is generated within outlook the font of Name_Lookup shows as Times new roman not basic commercial as the rest of the template is in. how do I change this? I hope this makes sense
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Neil FlemingConsultant and developer

Commented:
You seem to have a function called "RangeToHTML". What happens if you run Name_Lookup through that as well:

ie:
 Name_Lookup = RangeToHTML(ActiveSheet.Range("A3"))

Open in new window


(without the .Value)
Andrew WalkerCustomer Service Team Leader

Author

Commented:
Hi Neil
I amended the code as per your suggestion, and it does not pick up the value that is in A3, (which is the persons name) but does pull through the rest of the range from the stationary sheet
Andrew WalkerCustomer Service Team Leader

Author

Commented:
Hi Neil

I have attached I version of the file so you can see how it works, which may make it easier? I have only put the macro in the late card which can be selected  in the drop down in A1 the code is in module 2
Performance-Cards.xlsm
Consultant and developer
Commented:
Ah, ok. Since you are using the Ron de Bruin HTML maker, the easiest thing is actually to include the value from A3 in the stationary sheet at the moment you make the email

In the attached, I've added a row to make space for the name at the top of that sheet, and the code then adds the name to cell B1. I then set "rng" to cover one extra line.

Sheets("Stationary").Range("B1") = Name_Lookup
    Set rng = Sheets("Stationary").Range("B1:O9").SpecialCells(xlCellTypeVisible)  'range now spans B1 to O9

Open in new window


The formula you have in cell A3 doesn't seem to read "Mr X" correctly, but otherwise it works fine.

The email content creation line then reads:

.HTMLBody = RangetoHTML(rng)

Open in new window


since the person's name is already in the range "rng".

You can modify the break email code to do the same.
Performance-Cards.xlsm
Andrew WalkerCustomer Service Team Leader

Author

Commented:
Neil, sorry about delay in reply I have been on Holiday, thank you for all your help it works like a charm!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial