Question

我不是真正的VBA开发人员，我说我正在尝试修复Outlook 2013宏的一些问题。我遇到的最后一个问题是关于默认＆＃34;我们从此消息中删除了额外的换行符。＆＃34;我想出了在选项＆gt; mail＆gt;消息格式中取消选中此选项的位置，但我找不到任何关于如何以编程方式执行此操作的内容。

有可能吗？

Answer 1

Tony Dallimore是对的。

Outlook reads registry changes on start.所以变化不会立竿见影。下面带有辅助函数的示例代码。

Outlook在Windows注册表中存储删除明文消息中的额外换行符等选项。（对于我的计算机上的Outlook 2016，关键是（请注意版本16.0）：

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

VBA读取和写入Windows注册表的有限区域HKEY_CURRENT_USER\Software\VB and VBA Program Settings\。您可以使用 Windows脚本宿主对象模型库来read and edit the registry。

VBA旁注：Early binding并添加 Windows脚本宿主对象模型的参考资料有助于代码提示。（Visual Basic＆gt;工具＆gt;参考文献......）

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

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

1 个答案: