sub invio ()
Dim OutApp As Object
Dim OutMail As Object
Dim EmailAddr As String
Dim Subj As String
Dim BodyText As String
With OutMail
.ReadReceiptRequested = True
.To = xxx
.CC = Range("C1")
.BCC = Range("C4")
.Subject = "prova"
.HTMLBody = "prova invio"
.Attachments.Add
.Display
.SEND
End If
End With
Set OutMail = Nothing
Set OutApp = Nothing
end sub

Option Explicit

Public Sub Trascrive()
On Error GoTo Errore

Dim objWord As Object
Dim objDoc1 As Object
Dim sPath As String
Dim sNomeFile1 As String
Dim sh As Worksheet

    Set sh = ThisWorkbook.Worksheets("Foglio1")
    sPath = ThisWorkbook.Path
    sNomeFile1 = "Book.doc"
    Set objWord = CreateObject("Word.Application")
    
    With sh
        .[B2].ClearContents: .[B3].ClearContents
        Set objDoc1 = objWord.Documents.Open(sPath & "" & sNomeFile1)
        'adatta le due celle sotto alle tue esigenze
        .[B2].Value = objDoc1.Bookmarks("DATO1").Range.Text
        .[B3].Value = objDoc1.Bookmarks("DATO2").Range.Text
        objDoc1.Close
        Set objDoc1 = Nothing
    End With
     
Fine:
    If Not objWord Is Nothing Then
        objWord.Quit
        Set objWord = Nothing
    End If
    MsgBox "Trascrizione eseguita"
    Exit Sub
 
Errore:
    MsgBox Err.Number & vbNewLine & Err.Description
    Resume Fine
End Sub

Sub test()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sTesto As String
    Dim sString As String
    Dim oDO As Object
  
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Set oDO = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
    oDO.GetFromClipboard
    sTesto = oDO.GetText
    
    With OutMail
        .To = "pippo.baudo@pluto.it"
        .CC = ""
        .BCC = ""
        .Subject = "prova "
        .Body = sTesto
        .display
    End With


    Set OutMail = Nothing
    Set OutApp = Nothing
    Set oDO = Nothing

End Sub

Dim TextLine
DIm TestoHTML
Open "FILEPROV" For Input As #1    ' Apre il file.
Do While Not EOF(1)    ' Ripete fino alla fine del file.
    Line Input #1, TextLine    ' Assegna la riga a una variabile.
    TestoHTML = TestoHTML & LineTesto    
Loop
Close #1    ' Chiude il file.
[...]
With OutMail
.HTMLBody = TestoHTML
.Display
End With

Dim TextLine
DIm TestoHTML
Open "FILEPROV" For Input As #1    ' Apre il file.
Do While Not EOF(1)    ' Ripete fino alla fine del file.
    Line Input #1, TextLine    ' Assegna la riga a una variabile.
    TestoHTML = TestoHTML & TextLine    
Loop
Close #1    ' Chiude il file.
[...]
With OutMail
.HTMLBody = TestoHTML
.Display
End With

TestoHTML = TestoHTML & TextLine    & "     "