Как автоматически добавлять подпись в запросы на встречу в Outlook?

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

Автоматическая вставка подписи в запросы на встречи Outlook с помощью пользовательской формы

Автоматическая вставка подписи в запросы на встречи Outlook с помощью кода VBA

---

Автоматическая вставка подписи в запросы на встречи Outlook с помощью пользовательской формы

В Outlook вы можете создать пользовательскую форму для автоматической вставки подписи в запросы на встречи. Следуйте инструкциям ниже:

1. Перейдите в окно Календарь и нажмите Главная > Совещание, чтобы открыть новое окно Собрание.

2. Затем нажмите Вставка > Подпись и выберите нужную подпись для вставки (см. снимок экрана):

3. После вставки подписи нажмите Разработчик > Разработать эту форму в новом окне Собрание (см. снимок экрана):

4. На новом экране нажмите Разработчик > Опубликовать > Опубликовать форму как (см. снимок экрана):

5. В появившемся диалоговом окне Опубликовать форму как введите имя в поле Отображаемое имя и нажмите кнопку Опубликовать (см. снимок экрана):

6. Затем закройте текущее окно собрания без сохранения.

7. Теперь, когда вам нужно создать совещание с подписью, нажмите Главная > Новые элементы > Пользовательские формы и выберите только что созданную форму. Подпись будет автоматически вставлена в текст собрания (см. снимок экрана):

---

Автоматическая вставка подписи в запросы на встречи Outlook с помощью кода VBA

Приведённый ниже код VBA также поможет автоматически добавлять подпись в запросы на встречи. Выполните следующие шаги:

1. Удерживая клавиши ALT + F11, откройте окно Microsoft Visual Basic для приложений.

2. В окне Microsoft Visual Basic для приложений дважды щёлкните ThisOutlookSession на панели Project1 (VbaProject.OTM), чтобы открыть модуль, затем скопируйте и вставьте приведённый ниже код в пустой модуль.

Код VBA: Автоматическая вставка подписи в запросы на встречи:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim xMeetingItem As Outlook.MeetingItem
Dim xFSO As Scripting.FileSystemObject
Dim xSignStream, xWriteStream, xReadStream As Scripting.TextStream
Dim xSignFld, xSignSubFld As Scripting.Folder
Dim xSignFile As Scripting.File
Dim xSignText, xSignPath As String
Dim xMailRTFText, xMeetingRTFText, xAllRTFText As String
Dim xByte() As Byte
Dim xPos As Integer
Dim xFilePath, xFldPath, xFldName As String
Dim xMailItem As MailItem
On Error Resume Next
If Item.Class = olMeetingRequest Then
    Set xMeetingItem = Item
    Set xFSO = CreateObject("scripting.FileSystemObject")
    xSignPath = CStr(Environ("USERPROFILE")) & "\AppData\Roaming\Microsoft\Signatures\"
    Set xSignFld = xFSO.GetFolder(xSignPath)
    If xSignFld.SubFolders.Count <> 0 Then
        For Each xSignSubFld In xSignFld.SubFolders
            xFldName = xSignSubFld.Name
            xFldPath = xSignSubFld.Path
        Next
    End If
    For Each xSignFile In xSignFld.Files
        If xFSO.GetExtensionName(xSignFile.Path) = "htm" Then
            Set xSignStream = xFSO.OpenTextFile(xSignFile.Path)
            xSignText = xSignStream.ReadAll
            If InStr(xSignText, xFldName) <> 0 Then
                xSignText = Replace(xSignText, xFldName, xFldPath)
            End If
            Set xMailItem = Outlook.Application.CreateItem(olMailItem)
            xMailItem.HTMLBody = xSignText
            xMailRTFText = StrConv(xMailItem.RTFBody, vbUnicode)
            xMeetingRTFText = StrConv(xMeetingItem.RTFBody, vbUnicode)
            xPos = InStrRev(xMeetingRTFText, "{\*\htmltag104 </div>}\htmlrtf }\htmlrtf0")
            xFilePath = CreateObject("WScript.Shell").SpecialFolders(16)
            xFilePath = xFilePath & "\MeetingText.txt"
            If xFSO.FileExists(xFilePath) Then
                xFSO.DeleteFile xFilePath
            End If
            Set xWriteStream = xFSO.OpenTextFile(xFilePath, 8, True)
            xMeetingRTFText = Mid(xMeetingRTFText, 1, xPos - 1) & "{\*\htmltag72 </p>}{\*\htmltag0 \par }{\*\htmltag0 \par }" _
            & "{\*\htmltag64 <p class=MsoNormal>}\htmlrtf {\htmlrtf0 {\*\htmltag148 <span lang=EN-US style='color:#00B050'>}\htmlrtf {\htmlrtf0" _
            & "{\*\htmltag244 <o:p>}{\*\htmltag84 &nbsp;}\htmlrtf \'a0\htmlrtf0{\*\htmltag252 </o:p>}" _
            & "{\*\htmltag156 </span>}\htmlrtf }\htmlrtf0 \htmlrtf\par}\htmlrtf0" _
            & vbCrLf & xMailRTFText & vbCrLf & Mid(xMeetingRTFText, xPos, Len(xMeetingRTFText) - xPos + 1)
            xWriteStream.WriteLine xMeetingRTFText
            Set xReadStream = xFSO.OpenTextFile(xFilePath)
            xAllRTFText = xReadStream.ReadAll
            PackBytes xByte, xAllRTFText
            xMeetingItem.RTFBody = xByte
            xMeetingItem.Save
            xMailItem.Close olDiscard
        End If
    Next
End If
End Sub
Private Sub PackBytes(ByteArray() As Byte, ByVal PostData As String)
    ByteArray() = StrConv(PostData, vbFromUnicode)
End Sub

3. Сохраните и закройте окно кода. После этого при отправке исходящего приглашения на встречу указанная подпись будет автоматически вставляться. Чтобы проверить результат, перейдите в папку Отправленные: