使用拖放将 Outlook 消息导入文本框/富文本框

Question

我正在尝试将 Outlook 消息导入我的 vb.net 表单以填充文本框/富文本框。我使用了 Eric Moreau 的一些代码来处理导入功能。问题是代码会导入消息并将其保存到临时文件夹中。我的问题是我需要一个没有任何节省的解决方案。相反，它应该填充一个富文本框字段，然后我将使用该富文本框将其保存到应用程序的 my.settings 中。我似乎无法弄清楚要更改什么才能将行为从保存更改为实际填充我的字段。 代码如下（原代码全部归功于 Eric Moreau）

Option Strict On

Public Class MailDnD
Dim objOL As New Microsoft.Office.Interop.Outlook.Application

Private Sub me_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Me.DragDrop
    lblFile.Text = String.Empty
    Try

        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            'supports a drop of a file from Windows Explorer

            ' copy the name of the dragged files into a string array
            Dim draggedFiles As String() = CType(e.Data.GetData(DataFormats.FileDrop), String())

            'handle each file passed as needed
            For Each fileName As String In draggedFiles
                'hardcode a destination path for testing
                Dim strDestinationFile As String = _
                            IO.Path.Combine(My.Settings.TempFolder.ToString, _
                                            IO.Path.GetFileName(fileName))
                'test if source and destination are the same
                If strDestinationFile.Trim.ToUpper = fileName.Trim.ToUpper Then
                    lblFile.Text += strDestinationFile + _
                                    " - E-post meddelandet är redan importerat!" + _
                                    Environment.NewLine
                Else
                    lblFile.Text += "Importerar - " + _
                                    strDestinationFile + Environment.NewLine
                    IO.File.Copy(fileName, strDestinationFile)
                End If
            Next

        ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then
            'supports a drop of a Outlook message

            'Dim objMI As Object - if you want to do late-binding
            Dim objMI As Microsoft.Office.Interop.Outlook.MailItem

            For Each objMI In objOL.ActiveExplorer.Selection()
                'hardcode a destination path for testing
                Dim strFile As String = _
                            IO.Path.Combine(My.Settings.TempFolder.ToString, _
                                            (objMI.Subject + ".msg").Replace(":", ""))
                lblFile.Text += strFile + Environment.NewLine
                objMI.SaveAs(strFile)
            Next
        End If
        lblFormat.Text = String.Empty

    Catch ex As Exception
        lblFile.Text = "Ett fel uppstod vid import, vänligen testa igen" + Environment.NewLine + ex.ToString
    End Try
End Sub

''' <summary>
''' Reset the status label
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub me_DragLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.DragLeave
    lblFormat.Text = String.Empty
End Sub

''' <summary>
''' Handle the DragOver event
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks></remarks>
Private Sub me_DragOver(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Me.DragOver
    If e.Data.GetDataPresent(DataFormats.FileDrop) Then
        'handle a file dragged from Windows explorer
        e.Effect = DragDropEffects.Copy
        lblFormat.Text = "Dra över e-post meddelandet"
    ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then
        'handle a message dragged from Outllok
        e.Effect = DragDropEffects.Copy
        lblFormat.Text = "Dra över e-post meddelandet"
    Else
        'otherwise, do not handle
        e.Effect = DragDropEffects.None
        lblFormat.Text = ""
    End If
End Sub

只是为了澄清导入功能按预期工作。它将 Outlook 消息保存到文件夹，但我有点希望它不保存，而是将消息行导入到我的应用程序内的富文本框。如果您需要更多信息，请联系我

亲切的问候，

Answer 1

调整您的代码以仅获取一项并不难。您基本上只需要删除循环并使其选择第一项即可。

我切换到DragEnter 事件而不是DragOver，因为前者仅在鼠标进入表单时才被提升，而后者会持续提升直到对象被放下或鼠标离开表单。鼠标悬停在表单上时，放置数据无法更改，因此您不需要一直检查它。

我还冒昧地更正了一些“särskrivningar”:)，重命名了一些变量以便更好地理解，并进行了调整，以防止您在一次。

我已经对大部分代码进行了注释，但如果您有任何问题或不清楚的地方，请告诉我！

Dim Outlook As New Microsoft.Office.Interop.Outlook.Application

''' <summary>
''' Custom method called by the DragDrop event when a mail is dropped onto the application. 
''' Handles the updating of the User Interface.
''' </summary>
''' <param name="Mail">The mail dropped onto the application.</param>
''' <remarks></remarks>
Private Sub OnMailDropped(ByVal Mail As Microsoft.Office.Interop.Outlook.MailItem)
    SenderTextBox.Text = Mail.SenderEmailAddress
    SubjectTextBox.Text = Mail.Subject
    BodyRichTextBox.Text = Mail.Body
End Sub

Private Sub MailDnD_DragDrop(sender As Object, e As System.Windows.Forms.DragEventArgs) Handles Me.DragDrop
    Try
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then 'Supports the drop of a file from Windows Explorer.

            'Copy the names of the dragged files into a string array.
            Dim DraggedFiles As String() = CType(e.Data.GetData(DataFormats.FileDrop), String())

            'Check that only one file is selected.
            If DraggedFiles.Length = 0 Then
                lblFile.Text = "Inget e-postmeddelande valt!"
                Return 'Do not continue.

            ElseIf DraggedFiles.Length > 1 Then
                lblFile.Text = "Du kan endast importera ett e-postmeddelande i taget!"
                Return 'Do not continue.

            End If

            'Get the file path of the dragged file.
            Dim FileName As String = DraggedFiles(0) 'Regular arrays are zero-based, which means the very first item has index 0.

            'Load the file into a MailItem.
            Dim Mail As Microsoft.Office.Interop.Outlook.MailItem = _
                CType(Outlook.Session.OpenSharedItem(FileName), Microsoft.Office.Interop.Outlook.MailItem)

            'Update the status label.
            lblFile.Text = "Importerade: " & FileName

            'Invoke our custom method.
            OnMailDropped(Mail)

        ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then 'Supports the drop of a Outlook message.

            'Check that only one mail is selected.
            If Outlook.ActiveExplorer().Selection.Count = 0 Then
                lblFile.Text = "Inget e-postmeddelande markerat!"
                Return 'Do not continue.

            ElseIf Outlook.ActiveExplorer().Selection.Count > 1 Then
                lblFile.Text = "Du kan endast importera ett e-postmeddelande i taget!"
                Return 'Do not continue.

            End If

            'Get the selected mail.
            Dim Mail As Microsoft.Office.Interop.Outlook.MailItem = _
                CType(Outlook.ActiveExplorer().Selection(1), Microsoft.Office.Interop.Outlook.MailItem)
            'In Office applications the collections are one-based, thus we do ".Selection(1)" for the first item instead of ".Selection(0)".

            'Update the status label.
            lblFile.Text = "Importerade: " & Mail.Subject

            'Invoke our custom method.
            OnMailDropped(Mail)

        End If
    Catch ex As Exception
        lblFile.Text = "Ett fel uppstod vid import, vänligen testa igen" + Environment.NewLine + ex.ToString
    End Try
End Sub

Private Sub MailDnD_DragEnter(sender As Object, e As System.Windows.Forms.DragEventArgs) Handles Me.DragEnter
    If e.Data.GetDataPresent(DataFormats.FileDrop) _
        AndAlso CType(e.Data.GetData(DataFormats.FileDrop), String()).Length = 1 Then 'Allow only one file at a time.

        'Handle a file dragged from Windows explorer
        e.Effect = DragDropEffects.Copy
        lblFormat.Text = "Dra över e-postmeddelandet"

    ElseIf e.Data.GetDataPresent("FileGroupDescriptor") _
        AndAlso Outlook.ActiveExplorer().Selection.Count = 1 Then 'Allow only one mail at a time.

        'Handle a message dragged from Outlook
        e.Effect = DragDropEffects.Copy
        lblFormat.Text = "Dra över e-postmeddelandet"

    Else
        'Otherwise, do not handle
        e.Effect = DragDropEffects.None
        lblFormat.Text = ""
    End If
End Sub

代码注意事项：

• 每次将有效的电子邮件项/文件放到表单上时，都会调用自定义 OnMailDropped() 方法。

• SenderTextBox 是显示发件人电子邮件地址的文本框。

• SubjectTextBox 是显示电子邮件主题的文本框。

• BodyRichTextBox 是显示电子邮件正文的文本框。

您可能也注意到了，我将字符串与和号 (&) 连接，而不是加号 (+)。这是因为在 VB.NET 中 & 是本机字符串连接运算符。在某些情况下，使用 + 可能会导致问题。
请参阅The difference between + and & for joining strings in VB.NET 了解更多信息。

希望这会有所帮助！