Question

我正在尝试将Outlook消息导入到我的vb.net表单中以填充textboxes / richtextboxes。我使用了Eric Moreau的一些代码来处理导入功能。问题是代码导入消息并将其保存到临时文件夹。我的问题是，我需要一个没有任何保存的解决方案。相反，它应该填充richtextbox字段，然后我将使用该richtextbox将其保存到应用程序的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消息保存到文件夹，但我希望它不保存，而是将消息行导入到我的应用程序内的richtextbox。如果您需要更多信息，请与我联系

亲切的问候，

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。

希望这有帮助！

使用Drag＆amp; Drop将Outlook消息导入Textbox / Richtextbox

1 个答案: