"Method 'Publish' of object 'PublishObject failed"

[Sovereignty9]

I don't suppose any of you clever people would be able to help me out. I copied some code and adapted it to my needs. It worked fine for a few moments then all of a sudden I've started getting Runtime error 1004 and stating "Method 'Publish' of object 'PublishObject failed"


Thanks in advance

Joe

Public Sub prcSendMail()
    Dim objOutlook As Object, objMail As Object
    
    Set objOutlook = CreateObject(Class:="Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    
    With objMail
        .To = "[EMAIL="someone@somewhere.com"]someone@somewhere.com[/EMAIL]"
        .Cc = "[EMAIL="someone.else@somewhere.com"]someone.else@somewhere.com[/EMAIL]"
        .Subject = "Leaf Requirements " & Format(Now, "dd/mm/yy")
        .HTMLBody = fncRangeToHtml("LEAF PLAN 2", "P27:R46")
        .Display 'zum testen
'        .Send
    End With
    
    Set objMail = Nothing
    Set objOutlook = Nothing
    
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
Public Function fncConvertPictureToMail(strTempText As String, objWorksheet As Worksheet) As String
    Const HTM_START = "") - lngPathLeft)
    strTemp = Replace(strTemp, HTM_START & Chr$(34), "")
    strTemp = Replace(strTemp, HTM_END & Chr$(34), "")
    strTemp = strTemp & "/"
    
    strTempText = Replace(strTempText, strTemp, Environ$("temp") & "" & strTemp)
    fncConvertPictureToMail = strTempText
    
End Function