使用拖放将Outlook消息导入Textbox/Richtextbox

Question

我正在尝试将一条outlook消息导入到我的vb.net表单中，以填充文本框/富文本框。我使用了Eric的一些代码，它处理导入函数。问题是，代码导入消息并将其保存到临时文件夹中。我在这里的问题是，我需要一个没有任何储蓄的解决方案。相反，它应该填充一个richtextbox字段，然后我将使用这个richtextbox将其保存到应用程序的my.settings中。我似乎想不出该改变什么，才能改变自己的行为，从储蓄转变为实际生活在我的土地上。代码如下(原始代码为Eric提供的所有代码)

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事件，因为前者只在鼠标进入表单之后才会引发，而后者则会一直引发，直到对象被删除或鼠标离开窗体为止。无论如何，鼠标在窗体上时，drop数据不能更改，因此您不需要一直检查它。

我还冒昧地纠正了一些“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中，&是本机字符串连接运算符。在某些情况下，使用+可能会导致问题。

有关更多信息，请参见https://stackoverflow.com/q/734600。

希望这能有所帮助！