Outlook打印日志留存问题：如何捕获打印触发时机？

这个问题确实挺棘手的——Outlook对象模型确实没有像Word/Excel那样直接提供BeforePrint或AfterPrint事件，但有几个实用的方案可以帮你实现打印日志留存的需求，我来逐个拆解：

方案1：替换默认打印按钮，用自定义宏包裹打印逻辑 #

这是最直接易上手的方案，核心思路是把Outlook默认的打印入口（功能区按钮）替换成你自己的宏按钮，这样用户点击打印时会先执行你的日志记录代码，再调用原生的PrintOut方法。

具体步骤： #

1. 启用Outlook的开发者选项：打开File > Options > Customize Ribbon，勾选右侧的Developer选项卡，点击确定。
2. 自定义功能区：右键点击功能区的「打印」按钮，选择Customize the Ribbon，在弹出的窗口里新建一个自定义组，然后添加一个「宏」按钮到这个组里，把默认的打印按钮隐藏或替换掉。
3. 编写日志+打印的VBA宏：

Sub LogAndPrintCurrentMail()
    ' 获取当前选中/打开的邮件项
    Dim targetMail As Outlook.MailItem
    On Error Resume Next
    Set targetMail = Application.ActiveInspector.CurrentItem
    If targetMail Is Nothing Then
        ' 处理列表中选中的邮件
        Set targetMail = Application.ActiveExplorer.Selection.Item(1)
    End If
    On Error GoTo 0
    
    If Not targetMail Is Nothing Then
        ' ====== 日志留存逻辑 ======
        Dim logPath As String
        logPath = Environ("USERPROFILE") & "\Documents\OutlookPrintLogs.txt" ' 用用户文档目录避免权限问题
        Dim logFile As Integer
        logFile = FreeFile()
        Open logPath For Append As #logFile
        Print #logFile, Format(Now(), "yyyy-mm-dd hh:mm:ss") & " | 打印邮件 | 主题: " & targetMail.Subject & " | 发件人: " & targetMail.SenderName
        Close #logFile
        
        ' ====== 执行打印 ======
        targetMail.PrintOut
    End If
End Sub

优缺点：

• 优点：实现简单，不需要依赖复杂API，适合新手。
• 缺点：无法覆盖快捷键（如Ctrl+P）或右键菜单的打印操作，需要额外提醒用户使用自定义按钮，或者结合其他方案补充。

方案2：使用Windows API全局钩子捕获所有打印请求 #

如果需要覆盖所有打印场景（快捷键、右键菜单、功能区按钮），可以通过Windows API设置全局消息钩子，监听Outlook的打印命令消息。

核心思路： #

通过SetWindowsHookEx设置WH_GETMESSAGE钩子，拦截Outlook进程内的打印相关消息（比如WM_COMMAND对应的打印命令ID），一旦捕获到打印动作，就记录日志。

示例代码（需注意32/64位兼容性）： #

首先在标准模块中声明API（64位Outlook需加PtrSafe）：

' 64位Outlook声明
#If VBA7 Then
    Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private hHook As LongPtr
#Else
    ' 32位Outlook声明
    Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private hHook As Long
#End If

Const WH_GETMESSAGE = 3
Const WM_COMMAND = &H1
Const ID_FILE_PRINT = &H1 ' Outlook打印命令的标准ID，可根据实际情况调整

Public Sub InstallPrintHook()
    hHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf MessageProcessor, 0, GetCurrentThreadId())
End Sub

Public Sub UninstallPrintHook()
    If hHook <> 0 Then
        UnhookWindowsHookEx hHook
        hHook = 0
    End If
End Sub

Private Function MessageProcessor(ByVal nCode As Long, ByVal wParam As LongPtr, lParam As MSG) As LongPtr
    If nCode >= 0 Then
        ' 拦截WM_COMMAND消息，检查是否为打印命令
        If lParam.message = WM_COMMAND Then
            Dim cmdId As Long
            cmdId = lParam.wParam And &HFFFF&
            If cmdId = ID_FILE_PRINT Then
                ' 记录日志
                LogPrintAction
            End If
        End If
    End If
    ' 传递消息给下一个钩子
    MessageProcessor = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function

Private Sub LogPrintAction()
    Dim targetMail As Outlook.MailItem
    On Error Resume Next
    Set targetMail = Application.ActiveInspector.CurrentItem
    If targetMail Is Nothing Then
        Set targetMail = Application.ActiveExplorer.Selection.Item(1)
    End If
    On Error GoTo 0
    
    If Not targetMail Is Nothing Then
        Dim logPath As String
        logPath = Environ("USERPROFILE") & "\Documents\OutlookPrintLogs.txt"
        Dim logFile As Integer
        logFile = FreeFile()
        Open logPath For Append As #logFile
        Print #logFile, Format(Now(), "yyyy-mm-dd hh:mm:ss") & " | 钩子捕获打印 | 主题: " & targetMail.Subject & " | 发件人: " & targetMail.SenderName
        Close #logFile
    End If
End Sub

然后在ThisOutlookSession中添加启动/卸载钩子的代码：

Private Sub Application_Startup()
    InstallPrintHook
End Sub

Private Sub Application_Quit()
    UninstallPrintHook
End Sub

优缺点：

• 优点：覆盖所有打印场景，无需用户改变操作习惯。
• 缺点：API调用复杂，需要处理32/64位兼容性，调试难度稍高，且钩子可能会被杀毒软件误报。

方案3：监控邮件窗口的消息（针对性更强） #

如果只需要监控打开的邮件窗口的打印动作，可以通过类模块结合窗口消息监听来实现，避免全局钩子的复杂性。

核心思路： #

当邮件项加载时，创建一个监控类，绑定该邮件窗口，监听窗口内的打印消息，捕获到后记录日志。实现细节类似方案2，但钩子只针对单个邮件窗口，范围更小更安全。

注意事项 #

1. 宏权限设置：Outlook默认会禁用宏，需要在File > Options > Trust Center > Trust Center Settings > Macro Settings中选择「Enable all macros」（或添加信任位置）才能让代码正常运行。
2. 日志路径权限：尽量选择用户有权限写入的路径（如Documents目录），避免因权限问题导致日志写入失败。
3. 64位兼容性：如果使用64位Outlook，所有API声明必须加上PtrSafe关键字，否则会报错。

内容的提问来源于stack exchange，提问作者penera