Data Bars of Conditional formatting not copying over correctly into body of HTML email

Make sure the data bars are in cells that excel considers to be in the used range, or the range you specify to be captured.

If you still have a problem then you need to provide example of code and workbook used.

Andy , am using 'ActiveSheet.UsedRange' in my code.Below is my code.I have also attached my worksheet.

Sub Send_Click()

EmailRangeInHTML "abc.xyz@cde.com", "Team Results - Month-To-Date", ActiveSheet.UsedRange

End Sub

Sub EmailRangeInHTML(ByVal Recipient As String, ByVal Subject As String, Optional Range_To_Send As Variant)
  
Dim FSO As Object
  Dim HTMLcode As String
  Dim HTMLfile As Object
  Dim MyApp As Boolean
  Dim olApp As Object
  Dim Rng As Range
  Dim TempFile As String
  Dim Wks As Worksheet

  Const ForReading As Long = 1
  Const olMailItem = 0
  Const olFormatHTML = 2
  Const UseDefault As Long = -2
    
     On Error GoTo CleanUp
     
     If IsMissing(Range_To_Send) Then
        Set Rng = Selection
     Else
        Select Case TypeName(Range_To_Send)
          Case Is = "Range"
              Set Rng = Range_To_Send
          Case Is = "String"
              Set Rng = Evaluate(Range_To_Send)
          Case Else
              MsgBox "Your Selection is Not a Valid Range."
              GoTo CleanUp
        End Select
     End If
     
     ' Copy the worksheet to create a new workbook
       Set Wks = Rng.Parent
       Wks.Copy
     
     ' The new workbook will be saved to the user's Temp directoy
       TempFile = Environ("Temp") & "\" & Wks.Name & ".htm"
     
     ' If a file by this exists then delete it
       If Dir(TempFile) <> "" Then Kill TempFile
     
         ' Start Outlook
           Set olApp = CreateObject("Outlook.Application")
      
         ' Convert the Message worksheet into HTML
           With ActiveWorkbook.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             FileName:=TempFile, _
             Sheet:=Wks.Name, _
             Source:=Rng.Address, _
             HtmlType:=xlHtmlStatic)
            .Publish (True)
           End With
       
         ' Read the HTML file back as a string
           Set FSO = CreateObject("Scripting.FileSystemObject")
           Set HTMLfile = FSO.OpenTextFile(TempFile, ForReading, True, UseDefault)
           
            ' Read in the entire file as a string
              HTMLcode = HTMLfile.ReadAll
             
           HTMLfile.Close
          
          
         ' Re-align the HTML code to the left side of the page
           HTMLcode = Replace(HTMLcode, "align=center x:publishsource=", _
                              "align=left x:publishsource=")
                      
         ' Compose and send the email
           Set olEmail = olApp.CreateItem(olMailItem)
             With olEmail
               .To = Recipient
               .Subject = Subject
               .BodyFormat = olFormatHTML
               .HTMLBody = HTMLcode
               .Display
             End With
            
   ' Exit Outlook
    ' olApp.Quit
            
CleanUp:
   ' Did an error occur
     If Err <> 0 Then
        MsgBox "Run-time error '" & Err.Number & "':" & vbCrLf & vbCrLf & Err.Description
     End If
   
   ' Close the new workbook and don't save it
     ActiveWorkbook.Close SaveChanges:=False
  
   ' Delete the Temp File
     If Dir(TempFile) <> "" Then Kill TempFile
   
   ' Delete the Publish Object
     With ActiveWorkbook.PublishObjects
       If .Count <> 0 Then .Item(.Count).Delete
     End With
   
   
     With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
   ' Free memory resources
     Set olApp = Nothing
     Set olEmail = Nothing
     Set FSO = Nothing

End Sub

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

You will need to send the range as an image to include the CF databars.
http://www.rondebruin.nl/win/s1/outlook/amail7.htm

You can't. The databars are not actual cell content that you can create with html.
If you really wanted to include the cell shading as part of the table within an email then you would need to use a formula to fake the bar.

Something like the attached.

you could try this suggestion
http://www.vbforums.com/showthread.p...l-message-body

Managed to write this code , to copy and paste the cell range as image.But somehow it gives me a 'Permission Denied' error at
ActiveSheet.ChartObjects("EXPORT").Chart.Export "C:\SavedRange.jpg" .

Can you please help.

Sub Export()

    Dim FileName As String
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim ToList, CcList As String
    Dim oCht As Chart
    Dim oImg As Picture

    ToList = Sheets("Recipients").Range("B2").Value
    CcList = Sheets("Recipients").Range("B3").Value
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set rng = Nothing
    Set rng = ActiveSheet.UsedRange

   
    'Set oCht = Charts.Add
   
    'oCht.Paste
    'oCht.Export FileName:=Environ$("temp") & "\" & "SavedRange.jpg", Filtername:="JPG"
    'oCht.Delete
    
    Set oRange = rng.SpecialCells(xlCellTypeVisible)
    oRange.CopyPicture xlScreen, xlPicture
    With ActiveSheet.ChartObjects.Add(Left:=oRange.Left, Top:=oRange.Top, _
    Width:=oRange.Width, Height:=oRange.Height)
    .Name = "EXPORT"
    .Activate
    End With
    
    ActiveChart.Paste
    ActiveSheet.ChartObjects("EXPORT").Chart.Export "C:\SavedRange.jpg"
    ActiveSheet.ChartObjects("EXPORT").Delete
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
   
    With OutMail
        .To = ToList
        .CC = CcList
        .BCC = ""
        .Subject = "Pricing - Weekly Status Update - " + Format(Now(), "mmmm dd")
        '.HTMLBody = RangetoHTML(rng)
        .HTMLBody = "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
    "<IMG alt='' hspace=0 src='cid:SavedRange.jpg' align=baseline border=0>&nbsp;</BODY>"
       .Save
        
        .Display
        '.Send
    End With
 

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Why did you change the output folder location from your default temporary folder to the root directory?
You probably don't have permission to save files to the root folder.