When you drag objects off the Windows Desktop or out of the Windows Explorer, you are actually dragging files. In these cases, the format of the OLE DataObject is vbCFFiles and the object's Files collection, which contains the file names being dragged.
Listing 19.8 shows a simple file viewer. Drag a desktop icon onto the form, and the file's contents are displayed on the form background.
Listing 19.8 - Using the DataObject 's Files Collection
' Form property settings: ' OLEDropMode = Manual Private Sub Form_OLEDragOver(Data As DataObject, _ Effect As Long, Button As Integer, Shift As Integer, _ X As Single, Y As Single, State As Integer) ' Allow files to be dragged onto this form. If Data.GetFormat(vbCFFiles) Then Effect = vbDropEffectCopy ' Exclude other types of data. Else Effect = vbDropEffectNone End If End Sub Private Sub Form_OLEDragDrop(Data As DataObject, _ Effect As Long, Button As Integer, Shift As Integer, _ X As Single, Y As Single) Dim strTemp As String Dim filData ' Clear any text on the form. Cls ' Clear any background graphics on the form. Picture = LoadPicture("") ' Get the first file from the Files collection ' (ignore multiple selections). filData = Data.Files(1) ' Turn on error trapping. On Error Resume Next ' Try to load file as graphic... Picture = LoadPicture(filData) ' If error load as text. If Err Then ' Blast the file into a string variable. Open filData For Binary As #1 Len = FileLen(filData) strTemp = Space(FileLen(filData)) Get #1, , strTemp ' Print the string on the form. Print strTemp Close #1 End If ' Reset and turn off error handling. Err = 0 On Error GoTo 0 End Sub
The preceding code only deals with one file at a time. Also, it simply ignores directories; you can drag them onto the form, but nothing happens. To deal with multiple files, add a For...Each loop. For instance, Listing 19.9 creates a new form instance for each file selected.
Listing 19.9 - Modifications to Listing 19.8 to Handle Multiple File Selections.
Private Sub Form_OLEDragDrop(Data As DataObject, _ Effect As Long, Button As Integer, _ Shift As Integer, x As Single, Y As Single) Dim strTemp As String Dim filData, frmNew For Each filData In Data.Files Set frmNew = New Form1 frmNew.Show ' Display the file name. frmNew.Caption = filData ' Turn on error trapping. On Error Resume Next ' Try to load file as graphic... frmNew.Picture = LoadPicture(filData) ' If error load as text. If Err Then ' Blast the file into a string variable. Open filData For Binary As #1 Len = FileLen(filData) strTemp = Space(FileLen(filData)) Get #1, , strTemp ' Print the string on the form. frmNew.Print strTemp Close #1 End If Next filData ' Reset and turn off error handling. Err = 0 On Error GoTo 0 ' Remove this instance of the form. Unload Me End Sub
To exclude directories from the file list, use a For...Next loop in the OLEDragOver event. You need to use For...Next so you can keep track of the item number in the Files collection. You also need to count backwards (Step -1) so you don't get a Subscript out of range error when you remove items from the list. This is because collections automatically renumber their indexes as items are deleted. Listing 19.10 shows the modifications to Listing 19.8 that exclude directories from the file list.
Listing 19.10 - Using GetAtter to Prevent Directories from Being Dragged
Private Sub Form_OLEDragOver(Data As DataObject, _ Effect As Long, Button As Integer, Shift As Integer, _ x As Single, Y As Single, State As Integer) Dim i As Integer Dim filData ' Allow files to be dragged onto this form. If Data.GetFormat(vbCFFiles) Then ' For each file in the collection, counting ' backwards... For i = Data.Files.Count To 1 Step -1 filData = Data.Files(i) ' Check if it's a directory, if it is ' remove it from the collection. If GetAttr(filData) And vbDirectory Then Data.Files.Remove (i) End If Next i ' If there are any files left in the collection, ' let the user drop them, otherwise prohibit the drop. If Data.Files.Count Then Effect = vbDropEffectCopy Else Effect = vbDropEffectNone End If Else Effect = vbDropEffectNone End If End Sub