Question

我目前有一个Windows Forms应用程序，该应用程序可以接受来自其他应用程序的拖放文件。一切似乎都进行得很顺利，直到我们发现如果在电子邮件中添加一封电子邮件，事情就会变得很奇怪。

例如，用户将附件jpg或pdf文件直接从电子邮件拖到应用程序中没有问题。但是，当将电子邮件（.msg文件）附加到电子邮件，并且试图将附件电子邮件添加到程序时，将发生以下情况：以下代码能够正确读取所选附件的名称拖到程序中，但是实际复制的文件是包含电子邮件（包括所有附件）的主要文件。

有什么办法可以拉出所选/已拖延的消息？

谢谢！

这是整个功能：

Public Shared Function HandleFileDrops(ByVal e As System.Windows.Forms.DragEventArgs) As String
    ' Based on and Borrowed from http://allandynes.com/2015/10/vb-net-drag-and-drop-from-outlook/
    Try
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            ' We have a file so lets pass it to the calling form
            Dim Filename As String() = CType(e.Data.GetData(DataFormats.FileDrop), String())
            HandleFileDrops = Filename(0)
        ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then
            ' We have a embedded file. First lets try to get the file name out of memory
            Dim theStream As IO.Stream = CType(e.Data.GetData("FileGroupDescriptor"), IO.Stream)
            Dim fileGroupDescriptor(512) As Byte
            theStream.Read(fileGroupDescriptor, 0, 512)
            Dim fileName As System.Text.StringBuilder = New System.Text.StringBuilder("")
            Dim i As Integer = 76

            While Not (fileGroupDescriptor(i) = 0)
                fileName.Append(Convert.ToChar(fileGroupDescriptor(i)))
                System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
            End While

            theStream.Close()
            ' We should have the file name or if its an email, the subject line. Create our temp file based on the temp path and this info
            Dim myTempFile As String = IO.Path.GetTempPath & fileName.ToString
            ' Look to see if this is a email message. If so save that temporarily and get the temp file.
            If InStr(myTempFile, ".msg") > 0 Then
                Dim objOL As New Microsoft.Office.Interop.Outlook.Application
                Dim objMI As Microsoft.Office.Interop.Outlook.MailItem
                If objOL.ActiveExplorer.Selection.Count > 1 Then
                    MsgBox("You can only drag and drop one item at a time into this screen. Only the first item you selected will be used.", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "One Item At A Time")
                End If
                For Each objMI In objOL.ActiveExplorer.Selection()
                    objMI.SaveAs(myTempFile)
                    Exit For
                Next
                objOL = Nothing
                objMI = Nothing
            Else
                ' If its a attachment we need to pull the file itself out of memory
                Dim ms As IO.MemoryStream = CType(e.Data.GetData("FileContents", True), IO.MemoryStream)
                Dim FileBytes(CInt(ms.Length)) As Byte
                ' read the raw data into our variable
                ms.Position = 0
                ms.Read(FileBytes, 0, CInt(ms.Length))
                ms.Close()
                ' save the raw data into our temp file
                Dim fs As IO.FileStream = New IO.FileStream(myTempFile, IO.FileMode.OpenOrCreate, IO.FileAccess.Write)
                fs.Write(FileBytes, 0, FileBytes.Length)
                fs.Close()
            End If
            ' Make sure we have a actual file and also if we do make sure we erase it when done
            If IO.File.Exists(myTempFile) Then
                ' Assign the file name to the add dialog
                HandleFileDrops = myTempFile
            Else
                HandleFileDrops = String.Empty
            End If
        Else
            Throw New System.Exception("An exception has occurred.")
        End If
    Catch ex As Exception
        MsgBox("Could not copy file from memory. Please save the file to your hard drive first and then retry your drag and drop.", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "Drag and Drop Failed")
        HandleFileDrops = String.Empty
    End Try

End Function

这是专门处理电子邮件的部分：

                Dim objOL As New Microsoft.Office.Interop.Outlook.Application
                Dim objMI As Microsoft.Office.Interop.Outlook.MailItem
                If objOL.ActiveExplorer.Selection.Count > 1 Then
                    MsgBox("You can only drag and drop one item at a time into this screen. Only the first item you selected will be used.", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "One Item At A Time")
                End If
                For Each objMI In objOL.ActiveExplorer.Selection()
                    objMI.SaveAs(myTempFile)
                    Exit For
                Next
                objOL = Nothing
                objMI = Nothing

Answer 1

在真正查看了我从网络上其他地方借来的代码之后，现在我确切地看到了它的作用。保存Outlook消息的代码部分将创建当前Outlook对象的新实例，然后调用该对象以拉入其选定的项目，这将恰好是主要的选定电子邮件，而不是拖动的附件电子邮件。我能够添加几行代码来对电子邮件或附件名称进行一些比较，以了解到底是什么。

这现在可以很好地满足我的需求：

                Dim objOL As New Microsoft.Office.Interop.Outlook.Application
                Dim objMI As Microsoft.Office.Interop.Outlook.MailItem
                If objOL.ActiveExplorer.Selection.Count > 1 Then
                    MsgBox("You can only drag and drop one item at a time into this screen. Only the first item you selected will be used.", MsgBoxStyle.OkOnly Or MsgBoxStyle.Information, "One Item At A Time")
                End If

                'If the message itself has the same name as fileName, then just save the selected MailObject
                'Otherwise, iterate through all the attachments to the MailObject and save the one that hase that same name as the fileName
                For Each objMI In objOL.ActiveExplorer.Selection()
                    If objMI.Subject = fileName.ToString() Then
                        objMI.SaveAs(myTempFile)
                    Else 
                        Dim objAttach As Microsoft.Office.Interop.Outlook.Attachments = objMI.Attachments
                        For Each attach As Microsoft.Office.Interop.Outlook.Attachment In objAttach
                            If attach.FileName = fileName.ToString() Then
                                attach.SaveAsFile(myTempFile)
                            End If
                        Next
                    End If

                    Exit For
                Next
                objOL = Nothing
                objMI = Nothing

拖放到Outlook邮件到Windows窗体

1 个答案: