VBA Outlook如何取消选中删除纯文本中的额外换行符

我不是一个真正的VBA开发人员，也就是说，我正在尝试用Outlook 2013宏解决一些问题。我遇到的最后一个问题是关于默认的“我们从此邮件中删除了额外的换行符”。我在选项>邮件>邮件格式中找到了取消选中此选项的位置，但我找不到任何关于如何以编程方式执行此操作的信息

可能吗

没错

所以改变不会马上发生。下面是带有辅助函数的示例代码

Outlook在Windows注册表中存储选项，如删除纯文本消息中的额外换行符。（对于我的机器上的Outlook 2016，关键是（注意版本

16.0

）：

VBA读取和写入Windows注册表的有限区域，

HKEY\U CURRENT\U USER\Software\VB和VBA程序设置\

。您可以使用Windows脚本主机对象模型库来执行此操作

VBA旁注：添加Windows脚本宿主对象模型的引用有助于代码提示。（Visual Basic>工具>引用…）

选项显式
函数isRemoveExtraLineBreaksChecked（）为布尔值
“Outlook>
'文件>选项>
'邮件>消息格式>
'删除纯文本消息中的额外换行符
“在Outlook 2016 Professional Plus上测试，并在Windows 7 Professional上运行
将wsh暗显为新WshShell
Dim appVer作为字符串
将键变暗为字符串
作为整数的Dim val
appVer=partialVersionNumberString（Application.version）
key=“HKCU\Software\Microsoft\Office\”+appVer+“\Outlook\Options\Mail\AutoFormatPlainText”
val=wsh.重新研磨（键）
“收拾
设置wsh=Nothing
isRemoveExtraLineBreaksChecked=val=1
端函数
子集合RemoveExtralinebrakscheck（ByVal被检查为布尔值）
“Outlook>
'文件>选项>
'邮件>消息格式>
'删除纯文本消息中的额外换行符
“在Outlook 2016 Professional Plus上测试，并在Windows 7 Professional上运行
'
'必须重新启动Outlook才能读取新的注册表值
将wsh暗显为新WshShell
Dim appVer作为字符串
将键变暗为字符串
作为整数的Dim val
如果检查，则
val=1
其他的
val=0
如果结束
appVer=partialVersionNumberString（Application.version）
key=“HKCU\Software\Microsoft\Office\”+appVer+“\Outlook\Options\Mail\AutoFormatPlainText”
wsh.RegWrite key，val，“REG_DWORD”
“收拾
设置wsh=Nothing
端接头
函数partialVersionNumberString（ByVal版本为字符串_
可选ByVal numberOfGroups作为整数=2_
可选的ByVal inputSeparator为String=“.”_
可选ByVal outputSeparator As String=“”_
)作为字符串
'给定版本号，如16.0.0.9226
'返回16.0
调试。断言numberOfGroups>=0
Assert Len（inputSeparator）=1
Assert Len（outputselector）=1
Dim versionExpanded（）作为字符串
Dim VersionOutput（）作为字符串
versionExpanded=Split（Application.version，inputSeparator）
将组的实际数量调整为整数
Dim maxGroups作为整数
组的实际数量=阵列长度（版本扩展）
如果实际组数<组数，则
maxGroups=组的实际数量-1
其他的
maxGroups=numberOfGroups-1
如果结束
ReDim版本输出（最大组）
作为整数的Dim i
对于i=0到最大组
VersionOutput（i）=versionExpanded（i）
接下来我
partialVersionNumberString=Join（VersionOutput，outputSeparator）
端函数
函数arrayLen（anyArray作为变量）作为整数
arrayLen=UBound（anyArray）-LBound（anyArray）+1
端函数

我的理解是，这些选项记录在注册表中。如果有VBA访问注册表，我从未发现过。回答此问题的技巧可能会有所帮助：

HKCU\Software\Microsoft\Office\16.0\Outlook\Options\Mail\AutoFormatPlainText

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