Hello all.  I am currently using the code below for setting up an e-mail
function in excel.  If anyone here knows of any way to transfer this macro
for it to work on a word document rather than my excel sheet then any help
would be greatly appreciated.  Thanks in advance.

Sub correctionmail()
   Dim FileExtStr As String
   Dim FileFormatNum As Long
   Dim Sourcewb As Workbook
   Dim Destwb As Workbook
   Dim TempFilePath As String
   Dim TempFileName As String
   Dim OutApp As Object
   Dim OutMail As Object
   With Application
       .ScreenUpdating = False
       .EnableEvents = False
   End With
   Set Sourcewb = ActiveWorkbook
   ActiveSheet.Copy
   Set Destwb = ActiveWorkbook
   With Destwb
       If Val(Application.Version) < 12 Then
           FileExtStr = ".xls": FileFormatNum = -4143
       Else
           If Sourcewb.Name = .Name Then
               With Application
                   .ScreenUpdating = True
                   .EnableEvents = True
               End With
               MsgBox "Your answer is NO in the security dialog"
               Exit Sub
           Else
               Select Case Sourcewb.FileFormat
               Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
               Case 52:
                   If .HasVBProject Then
                       FileExtStr = ".xlsm": FileFormatNum = 52
                   Else
                       FileExtStr = ".xlsx": FileFormatNum = 51
                   End If
               Case 56: FileExtStr = ".xls": FileFormatNum = 56
               Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
               End Select
           End If
       End If
   End With

   TempFilePath = Environ$("temp") & "\"
   TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")

   Set OutApp = CreateObject("Outlook.Application")
   OutApp.Session.Logon
   Set OutMail = OutApp.CreateItem(0)

   With Destwb
       .SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
       On Error Resume Next
       With OutMail
           .To = ""
           .CC = ""
           .BCC = ""
           .Subject = ""
           .Body = ""
           .Attachments.Add Destwb.FullName
           .Display send it.
       End With
       On Error GoTo 0
       .Close SaveChanges:=False
   End With
   Kill TempFilePath & TempFileName & FileExtStr
   Set OutMail = Nothing
   Set OutApp = Nothing
   With Application
       .ScreenUpdating = True
       .EnableEvents = True
   End With
End Sub