2

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?

line breaks

Martijn Pieters
  • 889,049
  • 245
  • 3,507
  • 2,997
Lance
  • 61
  • 8
  • My understanding is that these options are recorded in the Registry. If there is VBA access to the Registry, I have never discovered it. The tricks in the answers to this question might help: [Outlook autocleaning my line breaks and screwing up my email format](https://stackoverflow.com/q/247546/973283) – Tony Dallimore Jun 06 '18 at 19:49

1 Answers1

2

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