'**************************************
' Name: Simple ole drag and drop
' Description:This demonstrates a simple
'     drag and drop of a file from windows exp
'     lorer into a text box then grab the file
'     name and path (this is part of the code 
'     im using to make a map install program f
'     or quake2)
' By: Stewart MacFarlane
'
' Inputs:a dropped file from windows exp
'     lorer
'
' Returns:incorrect file type
'
' Assumes:you must create a textbox call
'     ed text1 and make sure its big enough so
'     its not too fiddly to drop a file onto. 
'     also make sure for text1 oledragmode and
'     oledrop mode in the properties are set t
'     o manual
'
' Side Effects:none known
'
'This code is copyrighted and has' limited warranties.Please see http://w
'     ww.Planet-Source-Code.com/vb/scripts/Sho
'     wCode.asp?txtCodeId=6598&lngWId;=1'for details.'**************************************

Private Sub text1_OLEDragDrop(Data As DataObject, Effect As Long _

    , Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Prepare a variable (numfiles) and pass
    '     the number of files
    ' dropped onto text1 to this variable
    Dim numFiles As Integer
    numFiles = Data.Files.Count
    ' an example how to trap 1 file (can be 
    '     modified to trap as many
    ' or as little amount by changing the &g;
    '     t; 1 to > {new value}) then
    ' display a message box telling user the
    '     maximum allowed file drops)
    ' then exit the sub
    If numFiles > 1 Then 
    	MsgBox "Only allows 1 file at a time In beta version! Sorry!"_
    	,vbOKOnly, "Ooops beta version"
    	Exit Sub
End If

' check the attributes of the file being
'     dropped and see if it is a
' directory, if it is then warn user tha
'     t only files are valid to drop
' and exit the sub

If (GetAttr(Data.Files(1))) = vbDirectory Then
    MsgBox "Sorry this beta version only allows files Not directories to be installed"
    Exit Sub
End If

' check the file is the correct file typ
'     e (using its extension)
' if not then warn user and exit the sub
'     

If LCase(Right(Data.Files(1), 3)) <> LCase("bsp") Then
    MsgBox "This file is Not a quake 2 map (*.bsp)"
    Exit Sub
End If

' tell user the drag and drop was succes
'     ful
MsgBox Data.Files(1) + " installed"
' code here to install file
' or do what ever you need
' data.files(1) is a string holding the 
'     path and filename of the dropped file
' using a for..next loop you can control
'     multiple files dropped at once
' replacing the 1 with the for..next var
'     iable and using numfiles to find out
' the maximum for..next value
End Sub