VBA outlook Project moet automatisch gereset worden.

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Function ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Function
Sub CreateFromTemplate2()

    Dim myOlApp As Outlook.Application
    Dim MyItem As Outlook.MailItem
    Dim strlocation As String
    Dim StrBody As String
    Dim oxl As Object
     
strlocation = "C:\Users\...\Desktop\...\Daily transports " & Date & ".xlsx"

Set myOlApp = CreateObject("Outlook.Application")
Set MyItem = myOlApp.CreateItemFromTemplate("C:\Users\...\AppData\Roaming\Microsoft\Templates\Terugmelden transporten.oft")


 Set oxl = CreateObject("Excel.Application")
                 'Dim vValue As Range
        Dim oBook As Workbook
        Dim oSheet As Worksheet
        Dim rng As Range
 
        Set oBook = oxl.Workbooks.Open(strlocation)
        Set oSheet = oBook.Worksheets("Sheet1")

        'Set vValue = oSheet.Range("A1:G3").Value   'Get the value from cell A1

Set rng = Nothing
' Only send the visible cells in the selection.

Set rng = oSheet.Range("A:F").SpecialCells(xlCellTypeVisible)

    MyItem.HTMLBody = RangetoHTML(rng)
 
    MyItem.Subject = ("Daily transports " & Date)
 
Call ClearClipboard
 Set oSheet = Nothing
  oBook.Close
 Set oBook = Nothing
 oxl.Quit
 Set oxl = Nothing

MyItem.Display

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:=-4104
              
        On Error Resume Next
        .DrawingObjects.Visible = False
        .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
    
   DisplayAlerts = False
    TempWB.Close savechanges:=False
   DisplayAlerts = True
    'Delete the htm file we used in this function
    Kill TempFile
    

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
    
    
    
End Function