如何为Outlook的PickFolder文件夹选择对话框设置自定义标题？

好问题！Outlook自带的PickFolder方法确实没有直接设置对话框标题的参数，但我们可以通过Windows API来修改弹出的对话框标题，这样就不用提前用消息框告知用户当前要选择的文件夹类型了。下面是具体的实现步骤：

1. 声明所需的Windows API函数 #

首先，在你的VBA模块最顶部（所有子过程之外）添加这些API声明——它们负责查找窗口和修改窗口标题：

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
    (ByVal hwnd As LongPtr, ByVal lpString As String) As Long

提示：如果是32位版本的Outlook，把代码里的PtrSafe和LongPtr换成Long即可。

2. 封装带标题的文件夹选择函数 #

我们写一个自定义函数，它会先触发PickFolder，然后立即找到对话框并修改其标题：

Function PickFolderWithTitle(customTitle As String) As Outlook.Folder
    Dim olNs As Outlook.Namespace
    Dim targetFolder As Outlook.Folder
    ' 先获取Outlook命名空间
    Set olNs = GetObject("", "Outlook.Application").GetNamespace("MAPI")
    
    ' 用定时器延迟一点执行标题修改——确保对话框已经完全弹出
    Application.OnTime Now + TimeValue("00:00:00.5"), "'UpdateFolderDialogTitle """ & customTitle & """'"
    
    ' 调用原生PickFolder方法
    Set targetFolder = olNs.PickFolder
    
    Set PickFolderWithTitle = targetFolder
End Function

Sub UpdateFolderDialogTitle(newTitle As String)
    Dim dialogHwnd As LongPtr
    ' 查找Outlook的文件夹选择对话框（默认英文标题是"Select Folder"，中文Outlook是"选择文件夹"）
    dialogHwnd = FindWindow("#32770", "Select Folder")
    
    If dialogHwnd <> 0 Then
        ' 修改对话框标题为自定义内容
        SetWindowText dialogHwnd, newTitle
    End If
End Sub

注意：如果你的Outlook是中文版本，记得把FindWindow里的第二个参数改成"选择文件夹"——你可以先运行一次原生PickFolder确认默认标题。

3. 在你的代码中使用这个自定义函数 #

现在可以替换原来的代码，直接调用带标题的版本：

Sub SelectSourceAndTargetFolders()
    Dim SourceFolder As Outlook.Folder
    Dim TargetFolder As Outlook.Folder
    
    ' 选择源文件夹，标题明确提示用户操作
    Set SourceFolder = PickFolderWithTitle("请选择要处理的源文件夹")
    If SourceFolder Is Nothing Then Exit Sub ' 用户取消选择，直接退出
    
    ' 选择目标文件夹，同样设置明确标题
    Set TargetFolder = PickFolderWithTitle("请选择要输出的目标文件夹")
    If TargetFolder Is Nothing Then Exit Sub
    
    ' 这里写你的后续处理逻辑，比如邮件迁移、备份等
    MsgBox "已完成文件夹选择：" & vbCrLf & "源文件夹：" & SourceFolder.Name & vbCrLf & "目标文件夹：" & TargetFolder.Name
End Sub

一些实用小提示 #

• 定时器的延迟我设了0.5秒，你可以根据自己Outlook的响应速度调整，确保对话框弹出后再执行标题修改。
• 这个方案只适用于Windows系统的Outlook，Mac版Outlook不支持Windows API。
• 如果遇到找不到窗口的情况，优先检查默认标题是否和你的Outlook语言版本匹配。

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