Reputation: 61
I am not really a VBA developer, that said I am trying to fix a few issues with an Outlook 2013 macro. The last issue I am having is with regards to the default "We removed extra line breaks from this message." I figured out where to uncheck this option in the options>mail>message format but I cannot find anything on how to do this programmatically.
Is it possible?
Upvotes: 2
Views: 765
Reputation: 346
Tony Dallimore is right.
Outlook reads registry changes on start. So changes won't be immediate. Example code with helper functions below.
Outlook stores Options like Remove extra line breaks in plain text messages in the Windows Registry. (For Outlook 2016 on my machine the key is (note the version 16.0
):
HKCU\Software\Microsoft\Office\16.0\Outlook\Options\Mail\AutoFormatPlainText
VBA reads and writes to a limited area of the Windows Registry, HKEY_CURRENT_USER\Software\VB and VBA Program Settings\
. You can use the Windows Script Host Object Model library to read and edit the registry.
VBA side note: Early binding and adding the references for Windows Script Host Object Model helps with code prompting. (Visual Basic > Tools > References...)
Option Explicit
Function isRemoveExtraLineBreaksChecked() As Boolean
' Outlook >
' File > Options >
' Mail > Message format >
' Remove extra line breaks in plain text messages
' Tested on Outlook 2016 Professional Plus running on Windows 7 Professional
Dim wsh As New WshShell
Dim appVer As String
Dim key As String
Dim val As Integer
appVer = partialVersionNumberAsString(Application.version)
key = "HKCU\Software\Microsoft\Office\" + appVer + "\Outlook\Options\Mail\AutoFormatPlainText"
val = wsh.RegRead(key)
'Tidy Up
Set wsh = Nothing
isRemoveExtraLineBreaksChecked = val = 1
End Function
Sub setRemoveExtraLineBreaksCheck(ByVal checked As Boolean)
' Outlook >
' File > Options >
' Mail > Message format >
' Remove extra line breaks in plain text messages
' Tested on Outlook 2016 Professional Plus running on Windows 7 Professional
'
' Must restart Outlook so it can read new Registry value
Dim wsh As New WshShell
Dim appVer As String
Dim key As String
Dim val As Integer
If checked Then
val = 1
Else
val = 0
End If
appVer = partialVersionNumberAsString(Application.version)
key = "HKCU\Software\Microsoft\Office\" + appVer + "\Outlook\Options\Mail\AutoFormatPlainText"
wsh.RegWrite key, val, "REG_DWORD"
'Tidy Up
Set wsh = Nothing
End Sub
Function partialVersionNumberAsString(ByVal version As String, _
Optional ByVal numberOfGroups As Integer = 2, _
Optional ByVal inputSeparator As String = ".", _
Optional ByVal outputSeparator As String = "." _
) As String
' Given a version number like 16.0.0.9226
' Return 16.0
Debug.Assert numberOfGroups >= 0
Debug.Assert Len(inputSeparator) = 1
Debug.Assert Len(outputSeparator) = 1
Dim versionExpanded() As String
Dim versionToOutput() As String
versionExpanded = Split(Application.version, inputSeparator)
Dim actualNumberOfGroups As Integer
Dim maxGroups As Integer
actualNumberOfGroups = arrayLen(versionExpanded)
If actualNumberOfGroups < numberOfGroups Then
maxGroups = actualNumberOfGroups - 1
Else
maxGroups = numberOfGroups - 1
End If
ReDim versionToOutput(maxGroups)
Dim i As Integer
For i = 0 To maxGroups
versionToOutput(i) = versionExpanded(i)
Next i
partialVersionNumberAsString = Join(versionToOutput, outputSeparator)
End Function
Function arrayLen(anyArray As Variant) As Integer
arrayLen = UBound(anyArray) - LBound(anyArray) + 1
End Function
Upvotes: 2