如何在不引用Microsoft Windows Common Controls 6.0的情况下实现Outlook VBA用户窗体文件拖放

可以通过调用Windows原生API实现，完全不需要依赖"Microsoft Windows Common Controls 6.0"引用库，核心思路是通过API捕获拖放消息并手动解析文件列表，步骤如下：

1. 准备标准模块代码 #

新建一个标准模块（命名为modDragDrop），粘贴以下代码：

' Windows API 声明
Public Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Public Declare Function DragFinish Lib "shell32.dll" (ByVal hDrop As Long) As Long
Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

' 常量定义
Public Const WM_DROPFILES = &H233
Public lpPrevWndProc As Long

Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_DROPFILES Then
        Dim fileCount As Long
        Dim filePath As String
        Dim i As Long
        
        ' 获取拖放的文件总数
        fileCount = DragQueryFile(wParam, &HFFFFFFFF, vbNullString, 0)
        
        ' 逐个提取文件路径
        For i = 0 To fileCount - 1
            filePath = String(260, vbNullChar) ' 初始化缓冲区（Windows路径最大长度为260）
            DragQueryFile wParam, i, filePath, 260
            filePath = Left(filePath, InStr(filePath, vbNullChar) - 1) ' 去除末尾空字符
            
            ' 这里替换为你的业务逻辑，比如添加到用户窗体的列表框
            ' 示例：UserForm1.ListBox1.AddItem filePath
            Debug.Print "拖放文件：" & filePath
        Next i
        
        DragFinish wParam ' 结束拖放操作
        WindowProc = 0
        Exit Function
    End If
    
    ' 非拖放消息交给原窗口处理
    WindowProc = CallWindowProc(lpPrevWndProc, hwnd, Msg, wParam, lParam)
End Function

2. 编写用户窗体代码 #

打开你的自定义用户窗体，在代码窗口中粘贴以下内容：

' Windows API 声明
Private Declare Function DragAcceptFiles Lib "shell32.dll" (ByVal hwnd As Long, ByVal fAccept As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

' 常量定义
Private Const GWL_WNDPROC = (-4)

Private Sub UserForm_Initialize()
    ' 设置窗体接受文件拖放
    DragAcceptFiles Me.hwnd, 1
    ' 子类化窗口，替换消息处理过程以捕获拖放事件
    modDragDrop.lpPrevWndProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
    SetWindowLong Me.hwnd, GWL_WNDPROC, AddressOf modDragDrop.WindowProc
End Sub

Private Sub UserForm_Terminate()
    ' 恢复原窗口消息处理过程，避免Outlook崩溃
    SetWindowLong Me.hwnd, GWL_WNDPROC, modDragDrop.lpPrevWndProc
End Sub

3. 自定义业务逻辑 #

在标准模块的WindowProc函数中，将示例代码（Debug.Print或添加到列表框）替换为你需要的操作，比如将文件路径插入邮件附件、保存到指定文件夹等。

注意事项 #

• 必须在窗体关闭时恢复原窗口消息处理过程（UserForm_Terminate中的代码），否则可能导致Outlook异常
• 测试前请确保Outlook宏安全级别允许运行未签名宏（根据你的环境调整）
• 拖放的文件路径处理依赖Windows默认的最大路径长度（260字符），若需支持长路径可调整缓冲区大小

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