Поддержка пользовательских кнопок Outlook - PullRequest
Новая
       9

Поддержка пользовательских кнопок Outlook

0 голосов
/ 16 апреля 2019

Добрый день всем. Я пытаюсь устранить проблему с вкладкой «Сообщения» в Outlook 2016, периодически исчезающей. Я подозреваю, что причиной может быть код, связанный с пользовательской кнопкой конфиденциальности - код указан ниже. Я был бы очень признателен, если бы кто-то мог просмотреть код и сообщить, есть ли какие-либо проблемы с ним. Обратите внимание, что я не программист, и я не писал этот код. Большое спасибо заранее. 

Sub Private_Button_Push()
'On Error GoTo ErrorHandler

Dim myMail As MailItem
Set myMail = Application.ActiveInspector.CurrentItem

If myMail.Class <> olMail Then Exit Sub

Dim strPrivacyStatement As String
strPrivacyStatement = "ABC Ltd - Strictly Private & Confidential"

Select Case myMail.Sensitivity

    Case olPrivate
        'If MsgBox("Remove 'private' setting?", vbYesNo, "Sensitivity: 'normal'") = vbNo Then Exit Sub
        myMail.Sensitivity = olNormal
        Privacy_Wording False, strPrivacyStatement
        'MsgBox "This email has been made non-private again.", vbOKOnly, "Sensitivity: Normal"

    Case Else
        myMail.Sensitivity = olPrivate
        Privacy_Wording True, strPrivacyStatement
End Select

Exit Sub

ErrorHandler:
Select Case Err.Description
Case Is = "The sensitivity of this message cannot be changed. The message contains information that has been marked as private by the original author."
  MsgBox Err.Description, vbOKOnly, "Private email."
Case Else
    MsgBox "Please report the following error number to the IT Department: " & Err.Number, vbCritical, "Privacy setting error."
End Select

End Sub
Sub Privacy_Wording(SetPrivate As Boolean, strText As String)

Dim myInspector As Outlook.Inspector
Dim myItem As MailItem
Dim myFirstLine As String
Dim myDoc As Word.Document
Dim mySel As Word.Selection

Set myInspector = Application.ActiveInspector
Set myItem = myInspector.CurrentItem
Set myDoc = myInspector.WordEditor
Set mySel = myDoc.Windows(1).Selection

myFirstLine = myDoc.Range.Paragraphs(1).Range


Select Case SetPrivate

    Case True

    cPar = myDoc.Range(0, mySel.Paragraphs(1).Range.End).Paragraphs.Count
        With myDoc.Range
            .Collapse
            .InsertBefore vbCr & vbCr
            .Font.Name = "Arial"
            .Font.Size = 10
            .Font.ColorIndex = wdBlack
            .Font.Bold = False
            .Collapse
            .InsertBefore strText & vbCr
            .Font.Bold = True
            .Font.Name = "Arial"
            .Font.Size = 8
        End With
        If cPar = 1 And myFirstLine = Chr(13) Then mySel.Move wdParagraph, 2
    Case False

    For I = 3 To 1 Step -1

     With myDoc.Range.Find
        .Text = strText
        For x = 1 To I
            .Text = .Text & vbCr
        Next x

            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
            If .Found = True Then Exit Sub
        End With

    Next I

End Select

End Sub
...