L
Larry G. Robertson
Guest
It took me a while to figure this one out, I couldn't find anyone who posted this type of request so I decided to share the solution.
I am working on speech dictation for the Visually Impaired and tried using the "Dictate Button" built into Outlook but it screws up on the To, Cc and Bcc fields when it comes to auto-complete due to a trailing space and it allows spaces in an email address.
So I decided to use the System.Speech.Recognition and write my own which requires me to access Outlook via the keybd_event API.
The To, Cc, Bcc and Subject were easy to get and set text using WM_GETTEXT and WM_SETTEXT however the Message Body is a different story because it is actually a MS Word object.
What I wanted to do with the Message body was make basic punctuation and capitalization corrections.
Here is my code below that will allow you to make changes to the Message Body from an external VB Application.
Please if anyone knows a simplified method or could simplify the FindWindow and FindWindowEx lines it would make it much cleaner. Note: the key to success was the API Call to AccessibleObjectFromWindow.
This code is working perfectly for me, maybe someone else could use it as well.
Imports Microsoft.Office.Interop
Imports System.Runtime.InteropServices
Public Class Form1
' Add a COM reference to Microsoft Word 16.0 Object Library
' (The outlook new mail dialog's Message area is actually a MS Word object)
Private IID_IAccessible As Guid = New Guid("{618736E0-3C3D-11CF-810C-00AA00389B71}")
Private IID_IDispatch As Guid = New Guid("{00020400-0000-0000-c000-000000000046}")
<DllImport("oleacc.dll", EntryPoint:="AccessibleObjectFromWindow", CharSet:=CharSet.Auto)>
Private Shared Function AccessibleObjectFromWindow(
ByVal Hwnd As IntPtr,
ByVal dwId As UInt32,
ByVal riid() As Byte,
<MarshalAs(UnmanagedType.IDispatch)> ByRef ppvObject As Object
) As Int32
End Function
<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", EntryPoint:="FindWindowW")>
Public Shared Function FindWindow(
<MarshalAs(UnmanagedType.LPTStr)> ByVal lpClassName As String,
<MarshalAs(UnmanagedType.LPTStr)> ByVal lpWindowName As String
) As IntPtr
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Try
' Before you press this button
' You Must run Outlook 365 from your desktop first and open the new email dialog
' FYI to see what the code below is doing to get the HWnd
' (View Outlook New Message Dialog in Spy++ 64 Find Window Drag to Message Area)
' Move down the tree from the dialog box to get the "_WwG" class
Dim intptrLevel1Handle As IntPtr = FindWindow("rctrl_renwnd32", Nothing)
Dim intptrLevel2Handle As IntPtr = FindWindowEx(intptrLevel1Handle, Nothing, "AfxWndW", Nothing)
Dim intptrLevel3Handle As IntPtr = FindWindowEx(intptrLevel2Handle, Nothing, "AfxWndW", Nothing)
If intptrLevel3Handle = IntPtr.Zero Then
MsgBox("You must first open the new mail dialog in Outlook")
Exit Sub
End If
Dim intptrLevel4Handle As IntPtr = FindWindowEx(intptrLevel3Handle, Nothing, "#32770", Nothing)
Dim intptrLevel5Handle As IntPtr = FindWindowEx(intptrLevel4Handle, Nothing, "AfxWndA", Nothing)
Dim intptrLevel6Handle As IntPtr = FindWindowEx(intptrLevel5Handle, Nothing, "_WwB", Nothing)
' This is the Message Control Handle
Dim intptrMailMessageHandle As IntPtr = FindWindowEx(intptrLevel6Handle, Nothing, "_WwG", Nothing)
If Not (intptrMailMessageHandle = IntPtr.Zero) Then
Dim objOutlookSendMessageFieldMessage As Object = Nothing
'Dim objWwGHandle As IntPtr = IntPtr.Zero
'objWwGHandle = &H90C86
Dim ObjectID As UInteger = &HFFFFFFF0&
Dim iResult As Integer = AccessibleObjectFromWindow(
intptrMailMessageHandle,
ObjectID,
IID_IDispatch.ToByteArray(),
objOutlookSendMessageFieldMessage
)
Dim objWordApplication As Word.Application = objOutlookSendMessageFieldMessage.Application
Dim objectDocument As Word.Document = objWordApplication.ActiveDocument
'Insert a paragraph at the beginning of the document.
Dim objParagraph1 As Word.Paragraph
objParagraph1 = objectDocument.Content.Paragraphs.Add
objParagraph1.Range.Text = "Hello, I think there is a space before the period at the end of this sentence ."
Threading.Thread.Sleep(2000)
' Make changes to the paragraph
For intIndex As Integer = 1 To objectDocument.Paragraphs.Count
Dim strText As String = objectDocument.Paragraphs(intIndex).Range.Text
If strText <> "" Then
strText = strText.Replace("Hello", "Goodbye")
strText = strText.Replace("space before the ", "") ' Fix any Space before a period
strText = strText.Replace(" .", ".") ' Fix any Space before a period
objectDocument.Paragraphs(intIndex).Range.Text = strText
End If
Next
'oDoc.Close() 'this object model command is not available in e-mail
'objWordApplication.Quit() 'this object model command is not available in e-mail
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
Continue reading...
I am working on speech dictation for the Visually Impaired and tried using the "Dictate Button" built into Outlook but it screws up on the To, Cc and Bcc fields when it comes to auto-complete due to a trailing space and it allows spaces in an email address.
So I decided to use the System.Speech.Recognition and write my own which requires me to access Outlook via the keybd_event API.
The To, Cc, Bcc and Subject were easy to get and set text using WM_GETTEXT and WM_SETTEXT however the Message Body is a different story because it is actually a MS Word object.
What I wanted to do with the Message body was make basic punctuation and capitalization corrections.
Here is my code below that will allow you to make changes to the Message Body from an external VB Application.
Please if anyone knows a simplified method or could simplify the FindWindow and FindWindowEx lines it would make it much cleaner. Note: the key to success was the API Call to AccessibleObjectFromWindow.
This code is working perfectly for me, maybe someone else could use it as well.
Imports Microsoft.Office.Interop
Imports System.Runtime.InteropServices
Public Class Form1
' Add a COM reference to Microsoft Word 16.0 Object Library
' (The outlook new mail dialog's Message area is actually a MS Word object)
Private IID_IAccessible As Guid = New Guid("{618736E0-3C3D-11CF-810C-00AA00389B71}")
Private IID_IDispatch As Guid = New Guid("{00020400-0000-0000-c000-000000000046}")
<DllImport("oleacc.dll", EntryPoint:="AccessibleObjectFromWindow", CharSet:=CharSet.Auto)>
Private Shared Function AccessibleObjectFromWindow(
ByVal Hwnd As IntPtr,
ByVal dwId As UInt32,
ByVal riid() As Byte,
<MarshalAs(UnmanagedType.IDispatch)> ByRef ppvObject As Object
) As Int32
End Function
<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", EntryPoint:="FindWindowW")>
Public Shared Function FindWindow(
<MarshalAs(UnmanagedType.LPTStr)> ByVal lpClassName As String,
<MarshalAs(UnmanagedType.LPTStr)> ByVal lpWindowName As String
) As IntPtr
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Try
' Before you press this button
' You Must run Outlook 365 from your desktop first and open the new email dialog
' FYI to see what the code below is doing to get the HWnd
' (View Outlook New Message Dialog in Spy++ 64 Find Window Drag to Message Area)
' Move down the tree from the dialog box to get the "_WwG" class
Dim intptrLevel1Handle As IntPtr = FindWindow("rctrl_renwnd32", Nothing)
Dim intptrLevel2Handle As IntPtr = FindWindowEx(intptrLevel1Handle, Nothing, "AfxWndW", Nothing)
Dim intptrLevel3Handle As IntPtr = FindWindowEx(intptrLevel2Handle, Nothing, "AfxWndW", Nothing)
If intptrLevel3Handle = IntPtr.Zero Then
MsgBox("You must first open the new mail dialog in Outlook")
Exit Sub
End If
Dim intptrLevel4Handle As IntPtr = FindWindowEx(intptrLevel3Handle, Nothing, "#32770", Nothing)
Dim intptrLevel5Handle As IntPtr = FindWindowEx(intptrLevel4Handle, Nothing, "AfxWndA", Nothing)
Dim intptrLevel6Handle As IntPtr = FindWindowEx(intptrLevel5Handle, Nothing, "_WwB", Nothing)
' This is the Message Control Handle
Dim intptrMailMessageHandle As IntPtr = FindWindowEx(intptrLevel6Handle, Nothing, "_WwG", Nothing)
If Not (intptrMailMessageHandle = IntPtr.Zero) Then
Dim objOutlookSendMessageFieldMessage As Object = Nothing
'Dim objWwGHandle As IntPtr = IntPtr.Zero
'objWwGHandle = &H90C86
Dim ObjectID As UInteger = &HFFFFFFF0&
Dim iResult As Integer = AccessibleObjectFromWindow(
intptrMailMessageHandle,
ObjectID,
IID_IDispatch.ToByteArray(),
objOutlookSendMessageFieldMessage
)
Dim objWordApplication As Word.Application = objOutlookSendMessageFieldMessage.Application
Dim objectDocument As Word.Document = objWordApplication.ActiveDocument
'Insert a paragraph at the beginning of the document.
Dim objParagraph1 As Word.Paragraph
objParagraph1 = objectDocument.Content.Paragraphs.Add
objParagraph1.Range.Text = "Hello, I think there is a space before the period at the end of this sentence ."
Threading.Thread.Sleep(2000)
' Make changes to the paragraph
For intIndex As Integer = 1 To objectDocument.Paragraphs.Count
Dim strText As String = objectDocument.Paragraphs(intIndex).Range.Text
If strText <> "" Then
strText = strText.Replace("Hello", "Goodbye")
strText = strText.Replace("space before the ", "") ' Fix any Space before a period
strText = strText.Replace(" .", ".") ' Fix any Space before a period
objectDocument.Paragraphs(intIndex).Range.Text = strText
End If
Next
'oDoc.Close() 'this object model command is not available in e-mail
'objWordApplication.Quit() 'this object model command is not available in e-mail
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
Continue reading...