VB .NET Outlook 2016加载项主题行

时间:2017-07-20 14:41:07

标签: vb.net outlook

我正在使用Visual Studio 2015为Outlook 2016编写一个加载项。我在内置的New Mail选项卡中添加了一个按钮。点击后,它会添加单词" unencrypt"到主题行的末尾,然后发送电子邮件。

只要用户在输入主题后已标出主题行字段,此方法就可以正常工作。但是,如果您输入主题然后立即单击该按钮,它会清除主题行并将其替换为" unncrypt"。

然而,当我在调试中单步执行它工作正常 - 它保留了现有文本,即使我没有从主题行中跳出标签。我认为更新邮件项目的主题属性存在某种延迟,但我手动延迟了20秒,如果我没有在调试中单步执行,它仍然会消除主题行。

我在这里不知所措。有没有办法检查主题行文本框本身?或者其他一些方法来抓取文本,即使用户没有标记出来?

任何帮助将不胜感激!

Private Sub Button1_Click(sender As Object, e As RibbonControlEventArgs) Handles Button1.Click
    ' Get the Application object
    Dim application As Outlook.Application = Globals.ThisAddIn.Application

    ' Get the active Inspector object and check if is type of MailItem
    Dim inspector As Outlook.Inspector = application.ActiveInspector()
    Dim mailItem As Outlook.MailItem = TryCast(inspector.CurrentItem, Outlook.MailItem)
    If mailItem IsNot Nothing Then
        If mailItem.EntryID Is Nothing Then
            If Not IsNothing(mailItem.Subject) AndAlso ((mailItem.Subject.Contains(" unencrypt")) OrElse (mailItem.Subject.Contains("unencrypt "))) Then
                mailItem.Subject = mailItem.Subject
            'ElseIf IsNothing(mailItem.Subject) Then
                'System.Threading.Thread.Sleep(20000)
                'mailItem.Subject = mailItem.Subject + " unencrypt"
            Else
                mailItem.Subject = mailItem.Subject + " unencrypt"
            End If
            If Not IsNothing(mailItem.To) AndAlso mailItem.To.ToString().Trim <> "" Then
                mailItem.Send()
            Else
                MessageBox.Show("We need to know who to send this to. Make sure you enter at least one name.", "Microsoft Outlook", MessageBoxButtons.OK, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button1)
            End If
        End If
    End If
End Sub

编辑: Dmitry的回答让我得到了我需要的地方,但是对于其他不熟悉Windows API的人我添加了下面的代码,然后简单地从原始代码中调用了GetSubject函数,而不是使用mailItem.Subject属性。

<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function FindWindowEx(ByVal parentHandle As IntPtr, _
                                        ByVal childAfter As IntPtr, _
                                        ByVal lclassName As String, _
                                        ByVal windowTitle As String) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function FindWindow(ByVal lclassName As String, _
                                    ByVal lWindowName As String) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function GetWindowText(ByVal hWnd As IntPtr, _
                                        ByVal lpString As StringBuilder, _
                                        ByVal nMaxCount As Integer) As Integer
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function GetWindowTextLength(ByVal hwnd As IntPtr) As Integer
End Function

Private Function GetSubject(inspector As Outlook.Inspector) As String
    Try
        Dim inspectorHandle As IntPtr = FindWindow("rctrl_renwnd32", inspector.Caption)
        Dim windowLevel2Handle As IntPtr = FindWindowEx(inspectorHandle, IntPtr.Zero, "AfxWndW", "")
        Dim windowLevel3Handle As IntPtr = FindWindowEx(windowLevel2Handle, IntPtr.Zero, "AfxWndW", "")
        Dim windowLevel4Handle As IntPtr = FindWindowEx(windowLevel3Handle, IntPtr.Zero, "#32770", "")
        Dim SubjectHandle As IntPtr = FindWindowEx(windowLevel4Handle, IntPtr.Zero, "Static", "S&ubject")
        Dim SubjectTextBoxHandle As IntPtr = FindWindowEx(windowLevel4Handle, SubjectHandle, "RichEdit20WPT", "")
        Dim length As Integer = GetWindowTextLength(SubjectTextBoxHandle)
        Dim sb As New StringBuilder(length + 1)
        GetWindowText(SubjectTextBoxHandle, sb, sb.Capacity)

        Return sb.ToString()
    Catch
        Return ""
    End Try

End Function

1 个答案:

答案 0 :(得分:0)

重要的一点是,主题编辑框需要失去焦点,以便OOM了解变化。

您可以使用辅助功能API或原始Windows API来访问编辑框的内容,也可以尝试关注其他一些检查器控件,例如邮件正文编辑器。