I searched high and low for a way in VB.NET to be able to drag and drop Outlook emails onto a control or form. The closest thing I could find was written in C# and posted by FabioPoroli.
What I did is convert the code to VB.NET and modify it to work with any control or a form. (The original code created a custom control to capture the dropped items.)
The only known issue is when you drop multiple files from the file system it will only grab the first file. (I'm still trying to resolve this problem any help would be greatly appreciated.)
The code is attached in the Zip file and below is how to implement the code.
VB.NET Code:
Public Class Form1
Private WithEvents clsDropProcess As DragDropProcess.DragDropProcess 'This is so we can handle the drop event
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.ListBox1.AllowDrop = True 'You have to set AllowDrop on the control you wish to use to [i]True[/i]
clsDropProcess = New DragDropProcess.DragDropProcess(ListBox1) 'Create a new instance of the class and pass the control that you want to allow files to be dropped on
AddHandler clsDropProcess.DroppedByteArrayAvailable, AddressOf DropEvent 'Add a handler to get the files/emails that have been dropped
End Sub
Public Sub DropEvent(ByVal sender As Object, ByVal filename As String, ByVal bytes As Byte()) 'This is the event that will fire for each file/email that is dropped.
Please post some of the code you need help with (it makes it easier to help you)
If your problem has been solved then please mark the thread [RESOLVED].
Don't forget to Rate this post
"Pinky, you give a whole new meaning to the phrase, 'counter-intelligence'."-The Brain-
I'm trying to add the same feature which allows the drag/drop option with Outlook emails. I finally found your code using the DragDropProcess class which is great! The thing is, I'm having trouble figuring out what code to use in the DropEvent to copy an instance of an Outlook email .msg to whatever directory I choose.
Please post some of the code you need help with (it makes it easier to help you)
If your problem has been solved then please mark the thread [RESOLVED].
Don't forget to Rate this post
"Pinky, you give a whole new meaning to the phrase, 'counter-intelligence'."-The Brain-
Great. I really appreciate it. I was having a hard time understanding where the actual data in the email .msg was stored, or how to access it from the DropEvent Sub with just those 3 parameters.
Thanks for your code. I can drag & drop several attachments from Outlook.
However, if I try to drag & drop several files from a window explorer, only one file is added into listbox control, because only one event is fired. In the first case, one event is fired for every file dragged from Outlook.
Any idea what am I doing wrong?
Thanks for your code. I can drag & drop several attachments from Outlook.
However, if I try to drag & drop several files from a window explorer, only one file is added into listbox control, because only one event is fired. In the first case, one event is fired for every file dragged from Outlook.
Any idea what am I doing wrong?
...if I try to drag & drop several files from a window explorer, only one file is added into listbox control, because only one event is fired. In the first case, one event is fired for every file dragged from Outlook.
Any idea what am I doing wrong?
Originally Posted by ProphetBeal
The only known issue is when you drop multiple files from the file system it will only grab the first file. (I'm still trying to resolve this problem any help would be greatly appreciated.)
I have yet to resolve (and in all honesty I've forgotten about).
Please post some of the code you need help with (it makes it easier to help you)
If your problem has been solved then please mark the thread [RESOLVED].
Don't forget to Rate this post
"Pinky, you give a whole new meaning to the phrase, 'counter-intelligence'."-The Brain-
@ProphetBeal
"Originally Posted by ProphetBeal
The only known issue is when you drop multiple files from the file system it will only grab the first file. (I'm still trying to resolve this problem any help would be greatly appreciated.)
I have yet to resolve (and in all honesty I've forgotten about)."
--
I would like to ask if in the meantime you have solved this problem? Thanks in advance.
@ProphetBeal
I have a second question. There comes an event for each single mail. Wouldn't it be possible to send only one event for all mails together, which of course has parameters that are in nature collections of fileinformations (each element is the data for one mail). From a conceptual point of view, this would be better, because the user's drop action of a multiple selection of mails is one single action (the releasing of the mouse key), so it should result in one single event. Then it would be quite easier to give a message to the user like "your 5 mails have been dropped". In the scenario of one event per mail, how should I decide which event is the last one? Should I wait (using Thread.Sleep etc.) an arbitrary amount of time like e.g. 1000 ms and if no further event comes then I suppose it's finished?
@ProphetBeal
I would like to ask if in the meantime you have solved this problem? Thanks in advance.
Nope, you are welcome to give it a shot.
Originally Posted by Ling60
@ProphetBeal
I have a second question. There comes an event for each single mail. Wouldn't it be possible to send only one event for all mails together, which of course has parameters that are in nature collections of fileinformations (each element is the data for one mail). From a conceptual point of view, this would be better, because the user's drop action of a multiple selection of mails is one single action (the releasing of the mouse key), so it should result in one single event. Then it would be quite easier to give a message to the user like "your 5 mails have been dropped". In the scenario of one event per mail, how should I decide which event is the last one? Should I wait (using Thread.Sleep etc.) an arbitrary amount of time like e.g. 1000 ms and if no further event comes then I suppose it's finished?
It is indeed possible and you are free to add that method to this code. I understand what you are saying about counting each item and you are more than welcome to come up with something. What I use this code for is to capture emails from a user and then pass it to a document management system, which in then displays all the files the users has uploaded.
You are free to make whatever changes you like to this code, I just ask that you (or anyone using the code) add some comments about where they got the code from. Also if you do make any modifications that you think others would benefit from, feel free to post those code changes here.
Please post some of the code you need help with (it makes it easier to help you)
If your problem has been solved then please mark the thread [RESOLVED].
Don't forget to Rate this post
"Pinky, you give a whole new meaning to the phrase, 'counter-intelligence'."-The Brain-
Hi, I'm new to VB and the microsoft stack in general. I'm interested in providing drag and drop upload functionailty in a web component. Is it possible to port this code to a web (ActiveX?) component?
Next, I'm sure it's possible to port this code to whatever you need. Also if you are looking for just basic drag/drop functionality, it's alot easier than this. This code is mainly to support email messages (like an outlook msg), which you can't capture using the regular .NET methods.
Please post some of the code you need help with (it makes it easier to help you)
If your problem has been solved then please mark the thread [RESOLVED].
Don't forget to Rate this post
"Pinky, you give a whole new meaning to the phrase, 'counter-intelligence'."-The Brain-
Quite seriously you have saved me so much time it isn't funny, I have previously accomplished obtaining MSG's directly from the Exchange server using WebDAV, it was a pain.
I found the C# version of this then found your link at the bottom.
First thank you for this code, it's very useful and a shame for Microsoft not adding this to Framework.
Found a solution for the explorer drag drop bug.
You have to use DragQueryFile API.
Code:
<DllImport("shell32.dll", CharSet:=CharSet.Auto)> _
Public Shared Function DragQueryFile(ByVal hDrop As HandleRef, ByVal iFile As Integer, ByVal lpszFile As StringBuilder, ByVal cch As Integer) As Integer
End Function
Replace the GetFilename from that code and replace with the following GetFilenames function.
Code:
Private Function GetFilenames(ByVal dataObject As NativeMethods.IOleDataObject) As String()
Dim filenames As New Generic.List(Of String)
Try
Dim medium As New NativeMethods.STGMEDIUM()
Dim format As New NativeMethods.FORMATETC()
format.cfFormat = CUShort(NativeMethods.CF_HDROP)
format.dwAspect = NativeMethods.DVASPECT_CONTENT
format.lindex = -1
format.ptd = New IntPtr(0)
format.tymed = NativeMethods.TYMED_HGLOBAL Or NativeMethods.TYMED_ISTORAGE Or NativeMethods.TYMED_ISTREAM Or NativeMethods.TYMED_FILE
Dim result As Integer = dataObject.OleGetData(format, medium)
Dim hRef As New HandleRef(Nothing, medium.unionmember)
If NativeMethods.Succeeded(result) Then
Dim cFiles As Integer = NativeMethods.DragQueryFile(hRef, &HFFFFFFFF, Nothing, 0)
For i As Integer = 0 To cFiles - 1
Dim sb As New StringBuilder(256)
NativeMethods.DragQueryFile(hRef, i, sb, sb.Capacity + 1)
filenames.Add(sb.ToString)
Next
End If
Catch ex As Exception
Throw New Exception("Unable to determine the file name.", ex)
End Try
Return filenames.ToArray
End Function
Replace OleDragEnter with:
Code:
Private Function OleDragEnter(ByVal pDataObj As Object, ByVal grfKeyState As Integer, ByVal pt As Long, ByRef pdwEffect As Integer) As Integer Implements NativeMethods.IOleDropTarget.OleDragEnter
Try
' Default to DROPEFFECT_NONE
cachedEffect = DragDropEffects.None
'
' Does the data object support CFSTR_FILEDESCRIPTOR
If QueryGetFileDescriptorArray(DirectCast(pDataObj, NativeMethods.IOleDataObject)) Then
' Retrieve the list of files/folders
Dim dataObject As NativeMethods.IOleDataObject = DirectCast(pDataObj, NativeMethods.IOleDataObject)
Dim files As NativeMethods.FILEDESCRIPTOR() = GetFileDescriptorArray(dataObject)
If files Is Nothing OrElse files.Length = 0 Then
cachedEffect = DragDropEffects.Copy
Dim filenames() As String = GetFilenames(dataObject)
If filenames.Length > 0 Then
owner.DragEnter(filenames(0))
End If
Else
Dim firstFile As NativeMethods.FILEDESCRIPTOR = files(0)
Dim firstFilename As String = firstFile.cFileName
' Indicate that we can copy the item(s)
cachedEffect = DragDropEffects.Copy
owner.DragEnter(firstFilename)
End If
End If
pdwEffect = CInt(cachedEffect)
Return NativeMethods.S_OK
Catch ex As Exception
Throw New Exception("Error in the OLE Drag Enter.", ex)
End Try
End Function
Replace OleDrop with:
Code:
Private Function OleDrop(ByVal pDataObj As Object, ByVal grfKeyState As Integer, ByVal pt As Long, ByRef pdwEffect As Integer) As Integer Implements NativeMethods.IOleDropTarget.OleDrop
Dim result As Int64
Try
' Default to DROPEFFECT_NONE
cachedEffect = DragDropEffects.None
' Retrieve the list of files/folders
Dim dataObject As NativeMethods.IOleDataObject = DirectCast(pDataObj, NativeMethods.IOleDataObject)
Dim files As NativeMethods.FILEDESCRIPTOR() = GetFileDescriptorArray(dataObject)
If files IsNot Nothing AndAlso files.Length > 0 Then
result = CopyFileContents(DirectCast(pDataObj, NativeMethods.IOleDataObject), files)
If NativeMethods.Succeeded(CInt(result)) Then
owner.DragDrop()
cachedEffect = DragDropEffects.Copy
owner.Activate()
End If
Else
For Each filename As String In GetFilenames(dataObject)
SaveFilename(filename)
Next
owner.DragDrop()
owner.Activate()
End If
pdwEffect = CInt(cachedEffect)
Return NativeMethods.S_OK
Catch ex As Exception
Throw New Exception("Error in the OLE Drop.", ex)
End Try
End Function
Done some tests and it works. If you found any bug on this please reply.
First thank you for this great code a it's a shame for Microsoft not adding this to Framework.
I found a solution for the explorer drag drop single file bug.
You'll have to use DragQueryFile API.
Code:
<DllImport("shell32.dll", CharSet:=CharSet.Auto)> _
Public Shared Function DragQueryFile(ByVal hDrop As HandleRef, ByVal iFile As Integer, ByVal lpszFile As StringBuilder, ByVal cch As Integer) As Integer
End Function
Replace GetFilename with this new function GetFilenames:
Code:
Private Function GetFilenames(ByVal dataObject As NativeMethods.IOleDataObject) As String()
Dim filenames As New Generic.List(Of String)
Try
Dim medium As New NativeMethods.STGMEDIUM()
Dim format As New NativeMethods.FORMATETC()
format.cfFormat = CUShort(NativeMethods.CF_HDROP)
format.dwAspect = NativeMethods.DVASPECT_CONTENT
format.lindex = -1
format.ptd = New IntPtr(0)
format.tymed = NativeMethods.TYMED_HGLOBAL Or NativeMethods.TYMED_ISTORAGE Or NativeMethods.TYMED_ISTREAM Or NativeMethods.TYMED_FILE
Dim result As Integer = dataObject.OleGetData(format, medium)
Dim hRef As New HandleRef(Nothing, medium.unionmember)
If NativeMethods.Succeeded(result) Then
Dim cFiles As Integer = NativeMethods.DragQueryFile(hRef, &HFFFFFFFF, Nothing, 0)
For i As Integer = 0 To cFiles - 1
Dim sb As New StringBuilder(256)
NativeMethods.DragQueryFile(hRef, i, sb, sb.Capacity + 1)
filenames.Add(sb.ToString)
Next
End If
Catch ex As Exception
Throw New Exception("Unable to determine the file name.", ex)
End Try
Return filenames.ToArray
End Function
Replace OleDragEnter with:
Code:
Private Function OleDragEnter(ByVal pDataObj As Object, ByVal grfKeyState As Integer, ByVal pt As Long, ByRef pdwEffect As Integer) As Integer Implements NativeMethods.IOleDropTarget.OleDragEnter
Try
' Default to DROPEFFECT_NONE
cachedEffect = DragDropEffects.None
'
' Does the data object support CFSTR_FILEDESCRIPTOR
If QueryGetFileDescriptorArray(DirectCast(pDataObj, NativeMethods.IOleDataObject)) Then
' Retrieve the list of files/folders
Dim dataObject As NativeMethods.IOleDataObject = DirectCast(pDataObj, NativeMethods.IOleDataObject)
Dim files As NativeMethods.FILEDESCRIPTOR() = GetFileDescriptorArray(dataObject)
If files Is Nothing OrElse files.Length = 0 Then
cachedEffect = DragDropEffects.Copy
Dim filenames() As String = GetFilenames(dataObject)
If filenames.Length > 0 Then
owner.DragEnter(filenames(0))
End If
Else
Dim firstFile As NativeMethods.FILEDESCRIPTOR = files(0)
Dim firstFilename As String = firstFile.cFileName
' Indicate that we can copy the item(s)
cachedEffect = DragDropEffects.Copy
owner.DragEnter(firstFilename)
End If
End If
pdwEffect = CInt(cachedEffect)
Return NativeMethods.S_OK
Catch ex As Exception
Throw New Exception("Error in the OLE Drag Enter.", ex)
End Try
End Function
Replace OleDrop with:
Code:
Private Function OleDrop(ByVal pDataObj As Object, ByVal grfKeyState As Integer, ByVal pt As Long, ByRef pdwEffect As Integer) As Integer Implements NativeMethods.IOleDropTarget.OleDrop
Dim result As Int64
Try
' Default to DROPEFFECT_NONE
cachedEffect = DragDropEffects.None
' Retrieve the list of files/folders
Dim dataObject As NativeMethods.IOleDataObject = DirectCast(pDataObj, NativeMethods.IOleDataObject)
Dim files As NativeMethods.FILEDESCRIPTOR() = GetFileDescriptorArray(dataObject)
If files IsNot Nothing AndAlso files.Length > 0 Then
result = CopyFileContents(DirectCast(pDataObj, NativeMethods.IOleDataObject), files)
If NativeMethods.Succeeded(CInt(result)) Then
owner.DragDrop()
cachedEffect = DragDropEffects.Copy
owner.Activate()
End If
Else
For Each filename As String In GetFilenames(dataObject)
SaveFilename(filename)
Next
owner.DragDrop()
owner.Activate()
End If
pdwEffect = CInt(cachedEffect)
Return NativeMethods.S_OK
Catch ex As Exception
Throw New Exception("Error in the OLE Drop.", ex)
End Try
End Function
Done some tests and it works. If you found any bug please reply.
Hi, know this an older thread but I am trying to drop an email to a TreeView on a UserControl instead of a form in outlook 2007 using this dll/class and am getting an "Unable to initialize object" error (copied below). I am using VS 2008 and this application is dot net 4. hoping I'm just not initializing this correctly or something?
Any help appreciated.
Have this at top of the class
Code:
Public Class myUserControl
Public WithEvents clsDropProcess As DragDropProcess.DragDropProcess 'This is so we can handle the drop event
And this is my UserControl Load function
Code:
Private Sub UserControl1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'DRAG DROP
Me.TreeView1.AllowDrop = True
clsDropProcess = New DragDropProcess.DragDropProcess(TreeView1) 'Create a new instance of the class and pass the control that you want to allow files to be dropped on
AddHandler clsDropProcess.DroppedByteArrayAvailable, AddressOf DropEvent 'Add a handler to get the files/emails that have been dropped
InitializeRoot()
End Sub
System.Exception was unhandled by user code
Message=Unable to initialise object.
Source=DragDropProcess
StackTrace:
at DragDropProcess.DragDropProcess..ctor(Object sender) in D:\My Documents\Visual Studio 2005\Projects\DragDropProcess\DragDropProcess\clsMain.vb:line 1060
at OutlookExplorer.myUserControl.UserControl1_Load(Object sender, EventArgs e) in C:\Users\my.name\Desktop\Scripts\VB.Net\OutlookExplorer\OutlookExplorer\myUserControl.vb:line 30
at System.Windows.Forms.UserControl.OnLoad(EventArgs e)
at System.Windows.Forms.UserControl.OnCreateControl()
at System.Windows.Forms.Control.CreateControl(Boolean fIgnoreVisible)
at System.Windows.Forms.Control.CreateControl()
at System.Windows.Forms.Control.WmShowWindow(Message& m)
at System.Windows.Forms.Control.WndProc(Message& m)
at System.Windows.Forms.ScrollableControl.WndProc(Message& m)
at System.Windows.Forms.ContainerControl.WndProc(Message& m)
at System.Windows.Forms.UserControl.WndProc(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
at System.Windows.Forms.Control.ActiveXImpl.System.Windows.Forms.IWindowTarget.OnMessage(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
at System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)
InnerException: System.NullReferenceException
Message=Object reference not set to an instance of an object.
Source=DragDropProcess
StackTrace:
at DragDropProcess.DragDropProcess..ctor(Object sender) in D:\My Documents\Visual Studio 2005\Projects\DragDropProcess\DragDropProcess\clsMain.vb:line 1042
InnerException:
Finding this thread helped me a lot! I was able to drag and drop attachments from emails but not entire emails. I added NativeMethods.vb to my project. Ambiguity exists between "Imports System.Runtime.InteropServices" and "Imports System.Runtime.InteropServices.ComTypes". My code would only work importing ComTypes and referencing the other where needed. I'm posting this since the author said only single items would work, not multiple attachments or emails, and my example does multiples of anything: files, attachments, or emails. Works excellent. Thanks for supplying the code.
Code:
Private Sub TextBox1_DragDrop(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles TextBox1.DragDrop
Dim drop_inc_save As Integer = drop_inc
Try
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
Dim files() As String = e.Data.GetData(DataFormats.FileDrop)
For Each path In files
drop_inc += 1
IO.File.Copy(path, temp_folder & "\" & Format(drop_inc, "00000") & "." & path.Substring(path.LastIndexOf("\") + 1), False)
Next
ElseIf e.Data.GetDataPresent("FileGroupDescriptor") Then
non_file_drop(e)
Else
MsgBox("Items dropped were not files, emails, or email attachments")
Exit Sub
End If
Catch ex As System.Exception
temp_folder_clean(drop_inc_save + 1)
MsgBox("The drop action failed" & vbCrLf & vbCrLf & ex.Message)
End Try
Public Sub non_file_drop(ByVal e As System.Windows.Forms.DragEventArgs)
Dim mem_stream As MemoryStream = e.Data.GetData("FileGroupDescriptor")
Dim bytes(mem_stream.Length - 1) As Byte
mem_stream.Read(bytes, 0, mem_stream.Length)
mem_stream.Close()
Dim fnames$() = Nothing, sw As Boolean = False
For f1 As Integer = 76 To (bytes.Length - 1)
If bytes(f1) = 0 Then
sw = False
Else
If Not sw Then
sw = True
If IsNothing(fnames) Then ReDim fnames(0) Else ReDim Preserve fnames(fnames.Length)
fnames(fnames.Length - 1) = ""
End If
fnames(fnames.Length - 1) &= Chr(bytes(f1))
End If
Next f1
For f1 = 0 To (fnames.Length - 1)
fnames(f1) = fnames(f1).Replace("\", ".").Replace("/", ".").Replace("?", "").Replace("*", "").Replace("""", "")
Dim cdo As IDataObject = e.Data
Dim etc As New FORMATETC, fmat_long As Long = DataFormats.GetFormat("FileContents").Id
Dim fmat_short As Short = fmat_long And &H7FFF
If fmat_long > &H7FFF Then fmat_short = -32768 + (fmat_long - &H7FFF - 1)
With etc
.cfFormat = fmat_short
.dwAspect = DVASPECT.DVASPECT_CONTENT
.lindex = f1
.ptd = New IntPtr(0)
.tymed = TYMED.TYMED_ISTREAM Or TYMED.TYMED_ISTORAGE
End With
Dim medium As New STGMEDIUM
cdo.GetData(etc, medium)
Select Case medium.tymed
Case TYMED.TYMED_ISTREAM
Dim i_stream As IStream = Runtime.InteropServices.Marshal.GetObjectForIUnknown(medium.unionmember)
Runtime.InteropServices.Marshal.Release(medium.unionmember)
Dim stat As New STATSTG
i_stream.Stat(stat, 0)
Dim size As Integer = stat.cbSize
ReDim bytes(size - 1)
i_stream.Read(bytes, size, IntPtr.Zero)
drop_inc += 1
IO.File.WriteAllBytes(temp_folder & "\" & Format(drop_inc, "00000") & "." & fnames(f1), bytes)
Case TYMED.TYMED_ISTORAGE
Dim i_storage As NativeMethods.IStorage = DirectCast(Runtime.InteropServices.Marshal.GetTypedObjectForIUnknown(medium.unionmember, GetType(NativeMethods.IStorage)), NativeMethods.IStorage)
Dim grfFlags As UInteger = NativeMethods.STGM_CREATE Or NativeMethods.STGM_READWRITE Or NativeMethods.STGM_SHARE_EXCLUSIVE
Dim lpBytes As NativeMethods.ILockBytes = NativeMethods.CreateILockBytesOnHGlobal(IntPtr.Zero, True)
Dim lpDest As NativeMethods.IStorage = NativeMethods.StgCreateDocfileOnILockBytes(lpBytes, grfFlags, 0)
Try
i_storage.CopyTo(0, Nothing, IntPtr.Zero, lpDest)
lpBytes.Flush()
lpDest.Commit(NativeMethods.STGC_DEFAULT)
Dim pStatstg As New NativeMethods.STATSTG()
lpBytes.Stat(pStatstg, NativeMethods.STATFLAG_NONAME)
Dim hGlobal As IntPtr = NativeMethods.GetHGlobalFromILockBytes(lpBytes)
Dim hRef As New Runtime.InteropServices.HandleRef(Me, hGlobal)
Dim lpBuf As IntPtr = NativeMethods.GlobalLock(hRef)
Dim size As Integer = pStatstg.cbSize
ReDim bytes(size - 1)
Runtime.InteropServices.Marshal.Copy(lpBuf, bytes, 0, size)
NativeMethods.GlobalUnlock(hRef)
Runtime.InteropServices.Marshal.ReleaseComObject(lpDest)
Runtime.InteropServices.Marshal.ReleaseComObject(lpBytes)
drop_inc += 1
IO.File.WriteAllBytes(temp_folder & "\" & Format(drop_inc, "00000") & "." & fnames(f1), bytes)
Catch ex As Exception
Try : Runtime.InteropServices.Marshal.ReleaseComObject(lpDest) : Catch : End Try
Try : Runtime.InteropServices.Marshal.ReleaseComObject(lpBytes) : Catch : End Try
Throw ex
End Try
Case Else
Throw New Exception("an item dropped was not recognizable")
End Select
Next f1
End Sub
NativeMethods.vb
Imports System.Runtime.InteropServices.ComTypes