VB6 - Drag & Drop ListView items to Explorer

This sample code provides a reliable, non-API way of dropping items from a ListView control to a physical folder on the disk, using a popup menu.

The declarations:

vb Code:

Option Explicit
 
Private sExportedFile As String
 
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
 
Private Const KEY_TOGGLED As Long = &H1

The code:

vb Code:

Private Sub ListView1_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
AllowedEffects = vbDropEffectMove  'We want the file to be moved from its temporary location
Data.SetData vFormat:=vbCFFiles
sExportedFile = vbNullString  'Initialize the variable
End Sub
 
Private Sub ListView1_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)
If Not bDragOutside Then
    'I noticed that this event fires several times and GetKeyState returns -127 or -128 4 times before going outside the form.
    'When the mouse pointer goes outside the form, this event fires constantly and GetKeyState returns 0 or 1 (I don't know why).
    If GetKeyState(KEY_TOGGLED) >= 0 Then
        bDragOutside = True  'We're outside the form; don't let any code run in here again.
        'The drop process is now interrupted...
        Me.PopupMenu mnuFilesExport  '...until a choice is made or the user cancels (clicks somewhere else).
        'Each choice creates a file in a temporary directory and returns the full path into sExportedFile.
        Data.Files.Clear
        If sExportedFile <> vbNullString Then
            Data.Files.Add sExportedFile
            
            bDragOutside = False
        End If
    End If
End If
End Sub
 
Private Sub ListView1_OLECompleteDrag(Effect As Long)
bDragOutside = False
 
If sExportedFile <> vbNullString Then
    'FileExists is a routine I've written, which (obviously) checks if the file exists.
    If FileExists(sExportedFile) Then Kill sExportedFile
    'I "kill" the file because, if the drop operation is canceled, the file remains in its temporary location.
End If
End Sub

The concept is that we don't know (and don't need) the actual path to which the user wants to drop the item(s).
The Data.Files collection contains the files which are supposed to be copied (vbDropEffectCopy) or moved (vbDropEffectMove) to the drop location.

A possible modification for exporting more than one files is to make sExportFile a string array, check if sExportFile(0) = vbNullString, add each member to the data.files collection, and "kill" any files left behind.
Another modification could be removing the popupmenu (if there is only one option), and directing the program flow to a single routine of yours. The OLESetData event will continue as soon as that routine is finished.

For the curious people, here is the FileExists routine:

vb Code:

Public Function FileExists(strPath As String) As Boolean
On Error Resume Next
FileExists = Not (Dir(strPath, vbNormal Or vbReadOnly) = vbNullString)
If Err.Number <> 0 Then FileExists = False
End Function