Sub Rename_and_Send_As_Attachment()
'Graham Mayor - https://www.gmayor.com - Last updated - 08 Dec 2022
'Send the document as an attachment _
  in an Outlook Email message
'Requires the code from - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to either retrieve an open instance of Outlook or open Outlook if it is closed.
Dim bStarted As Boolean
Dim OlApp As Object
Dim oItem As Object
Dim oDoc As Document
Dim strDocName As String
Dim strName As String
Dim strPath As String
    Set oDoc = ActiveDocument
    On Error GoTo Err_Handler:
    
    strPath = Environ("TEMP") & "\"
    'Replace %20 in the filename with a space
    strName = Replace(oDoc.Name, "%20", " ")
    strDocName = strPath & strName
    oDoc.SaveAs2 strDocName
    
    'Now close the document without saving as we have finished with it
    oDoc.Close 0
    'Get Outlook if it's running
    Set OlApp = OutlookApp()
    On Error GoTo 0
    'Create a new mailitem
    Set oItem = OlApp.CreateItem(0)

    With oItem
        .Subject = strName
        .attachments.Add strDocName
        .Display
    End With

lbl_Exit:
    Set oItem = Nothing
    Set OlApp = Nothing
    'Delete the temporary file
    Kill strDocName
    Exit Sub
Err_Handler:
    Err.Clear
    GoTo lbl_Exit
End Sub