Здравствуйте уважаемые эксперты, ниже следует мой макрос.
Он делает: выделенный текст в документе сначала упаковывает его во временный файл помещает, далее этот файл прикрепляет в Оутлуке пользователь отправлет письмо самостоятельно, темпашка удаляется. И тот Исходный файл открывается. Остался последний ньюанс.
А именно был например документ на 78 листах, я выделил часть, например на 63 листе, макрос всё сделал и отрывает мне исходный документ, с которого я отправил письмо уже на 1 стр., не логично, как сделать, чтобы он открыл его в том же самом месте и чтобы выделенное осталось выделенным. Подскажи как, где, куда, что надо добавить!!


'условие о том выделен ли текст, если длина текста равна нулю, то есть пустому месту - "", тогда ...
If Len(Application.Selection.Range.Text) = 0 Then
'вывести надпись указанную в кавычках
MsgBox$ "Никакой текст не выделен", vbOKOnly, "Отправка письма программой Outlook не может быть выполнена"
'выйти из программы
Exit Sub
End If

Dim TempDocPath As String 'путь для сохранения временного документа
Dim FSO As Object 'системный объект для получения имени временного файла
Dim sFileName As String 'имя временного файла
Dim SelStart As Long 'начало выделения
Dim SelEnd As Long 'конец выделения

CurrDocPath = ActiveDocument.FullName 'путь к папке Temp
TempDocPath = Environ("Temp") 'запоминаем границы выделения
SelStart = Selection.Start
SelEnd = Selection.End
'получаем имя для временного файла
Set FSO = CreateObject("Scripting.FileSystemObject")
sFileName = FSO.GetTempName() 'временное имя для файла
TempDocPath = TempDocPath & "" & Mid(sFileName, 1, InStrRev(sFileName, ".")) & "doc" 'полный путь к временному файлу
ActiveDocument.SaveAs TempDocPath, 0, AddToRecentFiles:=False 'сохраняем активный документ, как временный файл
ActiveDocument.Range(SelEnd, ActiveDocument.Range.End).Delete 'удаляем всё, что находится после выделения
ActiveDocument.Range(0, SelStart).Delete 'удаляем всё, что находится до выделения

''''''''''''''''''''''''''''''''''''''''''
'таким образом в новом документе осталось только то, что было выделено в старом
''''''''''''''''''''''''''''''''''''''''''

Selection.Font.Color = wdColorRed 'окрасить выделенное в красный цвет
ActiveDocument.Close True 'закрываем активный документ с сохранением настроек

''''''''''''''''''''''''''''''''''''''''''
'отправка письма по Microsoft Outlook

'для работоспособности нужно добавить ссылку на библиотеку
'зайдите в меню Tools-References, найдите Microsoft Outlook Object Library, поставьте птичку

Dim objOL As Outlook.Application
Set objOL = Outlook.Application

Dim objMail As Outlook.MailItem
Set objMail = objOL.CreateItem(olMailItem)

Dim objAttach As Object
Set objAttach = objMail.Attachments

With objMail
.To = "" '"mm@mm.ru; dd@dd.ru" 'адрес e-mail для отправки письма, если несколько адресов e-mail, пишем, отделяя их точкой с запятой - ";"
.CC = "" 'копия
.Subject = "" 'это тема письма
'.Body = "Это текст письма" 'вариант отправки определённого текста
'.Body = ActiveDocument.Selection 'вариант отправки выделенного текста
.Attachments.Add TempDocPath '
'.Attachments.Add 'если надо второе вложенное письмо, тогда добавляем второй Attachments
.OriginatorDeliveryReportRequested = True 'уведомление о доставке письма
.ReadReceiptRequested = True 'уведомление о прочтении письма
.Save ' сохраним письмо
.Display 'показать окно письма, то есть показать открытую программу Outlook
'.Send 'отправить письмо автоматом
End With
Set objMail = Nothing
Set objOL = Nothing
Set objAttach = Nothing

Documents.Open CurrDocPath 'открываем старый, исходный документ
Kill TempDocPath 'удаляем временный документ
Set FSO = Nothing 'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
Спасибо