使用拖放将 Outlook 邮件导入 Textbox/Richtextbox
Import Outlook message to Textbox/Richtextbox using Drag&Drop
我正在尝试将 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。如果您需要更多信息，请联系我
亲切的问候，
调整您的代码以仅获取一项并不难。您基本上只需要删除循环并将其设为 select 第一项。
我切换到 DragEnter 事件而不是 DragOver 因为前者只会在鼠标进入表单时引发，而后者会持续引发直到对象被放下或鼠标离开表格。无论如何，当鼠标悬停在表单上时，拖放数据不会改变，因此您不需要一直检查它。
我还冒昧地更正了一些 "särskrivningar" :)，重命名了一些变量以便更好地理解，并进行了调整以使其不会让您删除一次超过一个 file/item。
我已经对大部分代码进行了评论，但如果您有任何疑问或有任何不清楚的地方，请告诉我！
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
代码注释：
每次将有效电子邮件 item/file 放入您的表单时，都会调用自定义 OnMailDropped() 方法。
SenderTextBox 是显示发件人电子邮件地址的文本框。
SubjectTextBox 是显示电子邮件主题的文本框。
BodyRichTextBox 是将显示电子邮件正文的文本框。
正如您可能已经注意到的那样，我将字符串与符号 (&) 而非加号 (+) 连接起来。这是因为 VB.NET & 是本机字符串连接运算符。使用 + 在某些情况下会导致问题。
有关详细信息，请参阅 The difference between + and & for joining strings in VB.NET。
希望对您有所帮助！
我正在尝试将 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。如果您需要更多信息，请联系我
亲切的问候，
调整您的代码以仅获取一项并不难。您基本上只需要删除循环并将其设为 select 第一项。
我切换到 DragEnter 事件而不是 DragOver 因为前者只会在鼠标进入表单时引发，而后者会持续引发直到对象被放下或鼠标离开表格。无论如何，当鼠标悬停在表单上时，拖放数据不会改变，因此您不需要一直检查它。
我还冒昧地更正了一些 "särskrivningar" :)，重命名了一些变量以便更好地理解，并进行了调整以使其不会让您删除一次超过一个 file/item。
我已经对大部分代码进行了评论，但如果您有任何疑问或有任何不清楚的地方，请告诉我！
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
代码注释：
每次将有效电子邮件 item/file 放入您的表单时，都会调用自定义
OnMailDropped()方法。SenderTextBox是显示发件人电子邮件地址的文本框。SubjectTextBox是显示电子邮件主题的文本框。BodyRichTextBox是将显示电子邮件正文的文本框。
正如您可能已经注意到的那样，我将字符串与符号 (&) 而非加号 (+) 连接起来。这是因为 VB.NET & 是本机字符串连接运算符。使用 + 在某些情况下会导致问题。
有关详细信息，请参阅 The difference between + and & for joining strings in VB.NET。
希望对您有所帮助！