无法从Outlook直接粘贴附件到VB.NET应用的技术问询

我的VB.NET应用中有一个按钮功能，可将用户剪贴板中的文档粘贴到列表中，但尝试直接复制粘贴Outlook附件时，应用提示“剪贴板中未检测到文件”，然而这些文件却可以正常粘贴到任意文件资源管理器中。请问是否可以通过代码实现Outlook附件的粘贴功能？

原功能代码 #

Private Sub btnPegar_Click(sender As Object, e As EventArgs) Handles btnPegar.Click
    ' 获取剪贴板数据
    If Clipboard.ContainsData(DataFormats.FileDrop) Then

        Dim fileDropList As String() = CType(Clipboard.GetData(DataFormats.FileDrop), String())

        ' 标记是否找到至少一个有效文件
        Dim archivoValidoEncontrado As Boolean = False

        ' 遍历文件列表并处理每个文件
        For Each filePath As String In fileDropList

            ' 获取文件扩展名
            Dim extensionActual As String = Path.GetExtension(filePath)

            ' 检查文件扩展名是否在允许范围内
            If extensionActual.Equals(".PDF", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".TIF", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".JPG", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".DOC", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".DOCX", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".XLS", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".XLSX", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".BMP", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".PNG", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".GIF", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".DOCUMSG", StringComparison.OrdinalIgnoreCase) OrElse
               extensionActual.Equals(".MSG", StringComparison.OrdinalIgnoreCase) Then

                ' 文件扩展名符合要求
                archivoValidoEncontrado = True

                Try
                    ' 检查文件是否已添加过
                    If archivosAgregados.Contains(filePath) Then                        
                        MessageBox.Show($"文件 '{Path.GetFileName(filePath)}' 已添加过。", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
                    Else
                        ' 将文件添加到已添加列表
                        archivosAgregados.Add(filePath)

                        ' 获取文件信息
                        Dim fileInfo As New System.IO.FileInfo(filePath)

                        ' 计算文件大小（KB）
                        Dim fileSizeBytes As Long = fileInfo.Length
                        Dim fileSizeKB As Double = fileSizeBytes / 1024
                        Dim roundedFileSizeKB As Double = Math.Round(fileSizeKB, 2)

                        ' 将文件信息添加到ListView
                        Dim LI As ListViewItem = Me.lstFiles.Items.Add(filePath)
                        LI.StateImageIndex = 0
                        LI.SubItems.Add(roundedFileSizeKB.ToString() & " KB")
                    End If
                Catch ex As Exception
                    MessageBox.Show($"检查文件 '{Path.GetFileName(filePath)}' 时出错: {ex.Message}", "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
                End Try
            End If
        Next

        ' 根据列表是否有文件启用/禁用按钮
        If lstFiles.Items.Count > 0 Then
            bProcesar.Enabled = True
            bEliminar.Enabled = True
        Else
            bProcesar.Enabled = False
            bEliminar.Enabled = False
        End If

        ' 所有文件扩展名都不符合要求
        If Not archivoValidoEncontrado Then
            MsgBox("剪贴板中的文件扩展名不被允许。")
        End If
    Else
        ' 剪贴板中没有文件
        MsgBox("剪贴板中不包含文件。")
    End If
End Sub

修改后代码（支持Outlook附件粘贴） #

Private Async Sub btnPegar_Click(sender As Object, e As EventArgs) Handles btnPegar.Click
    ' 检查剪贴板是否包含文件数据
    If Clipboard.ContainsData("FileGroupDescriptor") Then
        ' 获取剪贴板中Outlook附件的文件名
        Dim attachedFileNames As List(Of String) = Await GetAttachedFileNamesFromClipboardAsync(Clipboard.GetDataObject())

        ' 标记是否找到至少一个有效文件
        Dim archivoValidoEncontrado As Boolean = False

        ' 遍历附件文件名列表
        For Each fileName As String In attachedFileNames
            ' 检查文件扩展名是否在允许范围内
            Dim extensionActual As String = Path.GetExtension(fileName)

            If extensionActual.Equals(".PDF", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".TIF", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".JPG", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".DOC", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".DOCX", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".XLS", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".XLSX", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".BMP", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".PNG", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".GIF", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".DOCUMSG", StringComparison.OrdinalIgnoreCase) OrElse
           extensionActual.Equals(".MSG", StringComparison.OrdinalIgnoreCase) Then

                ' 文件扩展名符合要求
                archivoValidoEncontrado = True

                Try
                    Dim tempFilePath As String = Path.Combine(Path.GetTempPath(), fileName)
                    Await SaveAttachmentFromClipboardToFileAsync(Clipboard.GetDataObject(), tempFilePath)

                    ' 检查文件是否已添加过
                    If lstFiles.Items.Cast(Of ListViewItem)().Any(Function(item) item.Text = fileName) Then
                        ' 显示提示信息
                        MessageBox.Show($"文件 '{Path.GetFileName(fileName)}' 已添加过。", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
                    Else
                        ' 将文件添加到列表
                        Dim LI As ListViewItem = Me.lstFiles.Items.Add(fileName)
                        LI.StateImageIndex = 0

                        ' 获取文件大小并添加到列表
                        Dim fileSizeBytes As Long = New FileInfo(tempFilePath).Length
                        Dim fileSizeKB As Double = fileSizeBytes / 1024
                        Dim roundedFileSizeKB As Double = Math.Round(fileSizeKB, 2)
                        LI.SubItems.Add($"{roundedFileSizeKB} KB")

                        ' 将文件名添加到已添加列表
                        archivosAgregados.Add(fileName)
                    End If
                Catch ex As System.Exception
                    ' 处理异常
                    MessageBox.Show($"检查文件 '{Path.GetFileName(fileName)}' 时出错: {ex.Message}", "错误", MessageBoxButtons.OK, MessageBoxIcon.Error)
                End Try
            End If
        Next

        ' 根据列表是否有文件启用/禁用按钮
        If lstFiles.Items.Count > 0 Then
            bProcesar.Enabled = True
            bEliminar.Enabled = True
        Else
            bProcesar.Enabled = False
            bEliminar.Enabled = False
        End If

        If Not archivoValidoEncontrado Then
            MessageBox.Show("剪贴板中的文件扩展名不被允许。", "警告", MessageBoxButtons.OK, MessageBoxIcon.Warning)
        End If
    Else
        MessageBox.Show("剪贴板中不包含附件。", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
    End If
End Sub

' 获取剪贴板中附件的文件名
Private Async Function GetAttachedFileNamesFromClipboardAsync(clipboardData As IDataObject) As Task(Of List(Of String))
    Dim attachedFileNames As New List(Of String)()

    If Not clipboardData.GetDataPresent("FileGroupDescriptor") Then
        Return attachedFileNames
    End If

    Using descriptorStream As MemoryStream = TryCast(clipboardData.GetData("FileGroupDescriptor", True), MemoryStream)
        If descriptorStream IsNot Nothing Then
            Using streamReader As New StreamReader(descriptorStream)
                Dim streamContent As String = Await streamReader.ReadToEndAsync()
                Dim fileNames As String() = streamContent.Split(New Char() {ControlChars.NullChar}, StringSplitOptions.RemoveEmptyEntries)
                attachedFileNames.AddRange(fileNames.Skip(1))
            End Using
        End If
    End Using

    Return attachedFileNames
End Function

' 将剪贴板中的附件保存到磁盘
Private Async Function SaveAttachmentFromClipboardToFileAsync(clipboardData As IDataObject, destinationFilePath As String) As Task
    If Not clipboardData.GetDataPresent("FileContents") Then
        Return
    End If

    Using attachedFileStream As MemoryStream = TryCast(clipboardData.GetData("FileContents", True), MemoryStream)
        Using destinationFileStream As FileStream = File.Open(destinationFilePath, FileMode.OpenOrCreate)
            Await attachedFileStream.CopyToAsync(destinationFileStream)
        End Using
    End Using
End Function

内容的提问来源于stack exchange，提问作者Hugo Jiménez