Документ Word VBA, прикрепляющийся к электронной почте Outlook

#vba #outlook #ms-word #attachment

Вопрос:

Я отправляю людям документ Word с поддержкой макросов, чтобы они заполнили его и нажали кнопку «Отправить» в нижней части документа. Перед созданием элемента Outlook я хочу сохранить копию заполненного документа в папке «Мои документы» пользователя. Я знаю, что когда пользователь изначально открывает документ со своей электронной почты, он открывается только для чтения. Поэтому, чтобы добавить измененный документ обратно в новое электронное письмо Outlook (ответ), мне нужно сохранить его копию (в папке «Мои документы»). Сохранение работает правильно, но когда я пытаюсь прикрепить его, я получаю ошибку разрешений на файл в строке, в которой есть .Вложения.Добавить строку:

Ошибка во время выполнения ‘-2147024891 (80070005)’:

У вас нет соответствующего разрешения на выполнение этой операции.

Я знаю, что проблемы с разрешениями нет, потому что ручное создание электронной почты и прикрепление одного и того же файла работает правильно.

Вот мой код:

 Option Explicit

Private Sub CommandButton1_Click()

    Send_Email

End Sub

Private Sub Send_Email()

Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Dim Doc As Document
Dim strFilePath As String
Dim strAlertNumber As String

'On Error Resume Next
strAlertNumber = CellTrim(Me.Tables(1).Cell(1, 4).Range.Text)

strFilePath = Environ("HOMEDRIVE") amp; Environ("HOMEPATH") amp; "My Documents" amp; strAlertNumber amp; ".Docm"

Set Doc = ActiveDocument
Doc.SaveAs2 FileName:=strFilePath
Application.ScreenUpdating = False
Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)

With OutlookMail
    .BodyFormat = olFormatHTML
    .Display
    .Subject = "Acknowledgement Response for Alert #" amp; strAlertNumber
    .HTMLBody = "Here is my area's response to your Alert" amp; .HTMLBody
    .To = "[recipient email goes here]"
    .Attachments.Add strFilePath
    .Close (olSave)
End With

Application.ScreenUpdating = True

Set OutlookMail = Nothing
Set OutlookApp = Nothing

MsgBox ("Your Document Has Been Sent to the Project Lead")

End Sub


Private Function CellTrim(strCellContents) As String
    CellTrim = Left(strCellContents, Len(strCellContents) - 1)
End Function
 

Как я могу исправить это, чтобы мой суб-сервер Send_Email прикрепил заполненную форму обратно к электронному письму в качестве вложения?

Комментарии:

1. Прикрепляет ли какой-либо другой файл (например,». Вложения. Добавить «c:temptest.txt»‘) работа? Кроме того, почему вы отображаете сообщение и сразу же закрываете его?