adding a range of cells and paste into email and do a count

[Patriot2879]

Hello good afternoon, i have the code below where the top code does a count on click but then it goes straight into an email where i want it to copy cells H5 to R5 into the email and in the text it adds how many times the button has been clicked. but i am getting an error please can you help.

Private Sub CommandButton8_Click()
Range("Z1").Value = Range("Z1").Value + 1

End With

Dim aOutlook As Object
Dim aEmail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
Dim fncRangeToHtml As Range

    Set aOutlook = CreateObject("Outlook.Application")
    Set aEmail = aOutlook.CreateItem(0)

    aEmail.HTMLBody = fncRangeToHtml("Handover", "H5:R5") & _
                    "Hi, 
Please can we chased this job, this has been chased " & Worksheets("Handover").Range("Z1").Value & " time" & "
" & _
                "Many Thanks
" & _
                "New Connections Team
" & _
                ""
    
    aEmail.Recipients.Add (Worksheets("Email Links").Range("B2").Value)
    aEmail.CC = ""
    aEmail.BCC = ""
    aEmail.Subject = "" & Range("C1").Value & " " & Range("K1").Value
    aEmail.Display
    
End Sub

Private Function fncRangeToHtml( _
    strWorksheetName As String, _
    strRangeAddress As String) As String
    
    Dim objFilesytem As Object, objTextstream As Object, objShape As Shape
    Dim strFilename As String, strTempText As String
    Dim blnRangeContainsShapes As Boolean
    
    strFilename = Environ$("temp") & "\" & _
        Format(Now, "dd-mm-yy_h-mm-ss") & ".htm"
        
    ThisWorkbook.PublishObjects.Add( _
        SourceType:=xlSourceRange, _
        Filename:=strFilename, _
        Sheet:=strWorksheetName, _
        Source:=strRangeAddress, _
        HtmlType:=xlHtmlStatic).Publish True
        
    Set objFilesytem = CreateObject("Scripting.FileSystemObject")
    Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2)
    strTempText = objTextstream.ReadAll
    objTextstream.Close
    
    For Each objShape In Worksheets(strWorksheetName).Shapes
        If Not Intersect(objShape.TopLeftCell, Worksheets( _
            strWorksheetName).Range(strRangeAddress)) Is Nothing Then
            
            blnRangeContainsShapes = True
            Exit For
            
        End If
    Next
    
    If blnRangeContainsShapes Then _
        strTempText = fncConvertPictureToMail(strTempText, Worksheets(strWorksheetName))
    
    fncRangeToHtml = strTempText
    fncRangeToHtml = Replace(fncRangeToHtml, "align=center x:publishsource=", "align=left x:publishsource=")
    
    Set objTextstream = Nothing
    Set objFilesytem = Nothing
    
    Kill strFilename
    
End Function

 

[Domenic]

You're probably get an error because you're declaring your function fncRangeToHtml as a range within your sub CommandButton8_Click(). So try deleting this line...

Dim fncRangeToHtml As Range

Also, I noticed that you seem to have an extraneous End With at the beginning of your code. You'll need to remove it or address it appropriately.