Drag Files to ListBox 1

[Bubbler]

How do I enable users to drag files from a folder or the desktop, drop to a ListBox and have it so it creates a copy of the file in the folder that the list box is reading from?



Private Sub Form_Load()
ListDir "c:\", "*.*"
End Sub

Private Sub ListDir(ThisPath As String, ThisPattern As String)
On Error GoTo 1
Dim Thisfile As String
Dim char As String

List1.Clear
If Right$(ThisPath, 1) <> &quot;\&quot; Then ThisPath = ThisPath + &quot;\&quot;
Thisfile = Dir$(ThisPath + ThisPattern, 0)

List1.Tag = ThisPath
Dim x As Integer
ReDim arrFile(0)
Do While Thisfile <> &quot;&quot;

ReDim Preserve arrFile(x)
arrFile(x) = Thisfile
x = x + 1
On Error Resume Next
char = InStrRev(Right(Thisfile, 5), &quot;.&quot
On Error GoTo 0
Select Case char
Case 1, 2, 3, 4
List1.AddItem Left(Thisfile, Len(Thisfile) - (5 - char + 1))
Case Else
'Unknown extension so add the file to list
List1.AddItem Thisfile
End Select
Thisfile = Dir$
Loop

Exit Sub

1 MsgBox &quot;Drive not reading&quot;

End Sub

 

[Hypetia]

You can enable drag drop of files from Windows Explorer by OLE drag/drop. Place a listbox (List1) on you form and try the following code. It will enable you to drag/drop files from explorer/desktop displaying their path in the listbox.
___
[tt]
Option Explicit

Private Sub Form_Load()
List1.OLEDropMode = vbOLEDropManual 'enable drag/drop
End Sub

Private Sub Form_Resize()
List1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub List1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Data.GetFormat(vbCFFiles) Then 'if files are present then
Dim F As Variant
For Each F In Data.Files 'add files to the listbox
List1.AddItem F
Next
End If
End Sub

Private Sub List1_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
'if files are dragged then enable copy effect (Pointer with a + sign)
Effect = IIf(Data.GetFormat(vbCFFiles), Effect And vbDropEffectCopy, 0)
End Sub[/tt]
___

The last part of your question is unclear to me.

>... and have it so it creates a copy of the file in the folder that the list box is reading from?

Do you want to create a copy of each file in its own folder? If so, you can use the FileCopy statement to duplicate these files with some other name.

For example the following code will make a backup copy of all those files which are displayed in the list box.
___
[tt]
Dim N As Integer, FullName As String
For N = 0 To List1.ListCount - 1
FullName = List1.List(N)
FileCopy FullName, FullName & &quot;.bak&quot;
Next[/tt]
___

On the other hand if you want to copy these files into the folder name which you stored in the 'Tag' property of the listbox in your code then the following code will be helpful.
___
[tt]
Dim N As Integer, FullName As String, BaseName As String
For N = 0 To List1.ListCount - 1
FullName = List1.List(N)
BaseName = Mid$(FullName, InStrRev(FullName, &quot;\&quot + 1)
FileCopy FullName, List1.Tag & BaseName
Next[/tt]
___

You can execute this code, for example, in the Click event of a command button.
Hope this helps.

 

[Bubbler]

This is harder to explain than I though, below is the code that LPlates showed me, place a ListBox on a form and insert this, change the directory path in the load as needed. This lists shortcut files and executes them whe clicked on. What I am hoping to do now is enaboe this istBox to accept a dragged and droped shortcut from the desktop, open folders, explorer etc. SO that it adds it to the Listox List and also makes a copy of it the folder, in this example the shortcut would be placed in the C:\Program Files\Microsoft Visual Studio\Common\VSS Folder

Option Explicit
Dim arrFile() As String
Const SW_SHOWNORMAL = 1
Private Declare Function ShellExecute Lib &quot;shell32.dll&quot; Alias &quot;ShellExecuteA&quot; (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Form_Load()
ListDir &quot;C:\Program Files\Microsoft Visual Studio\Common\VSS&quot;, &quot;*.lnk&quot;
End Sub

Private Sub List1_DblClick()
Dim ExPath
ExPath = List1.Tag & arrFile(List1.ListIndex)
ShellExecute hwnd, &quot;open&quot;, ExPath, vbNullString, vbNullString, SW_SHOWNORMAL
End Sub

Private Sub ListDir(ThisPath As String, ThisPattern As String)
On Error GoTo 1
Dim Thisfile As String
Dim char As String

List1.Clear
If Right$(ThisPath, 1) <> &quot;\&quot; Then ThisPath = ThisPath + &quot;\&quot;
Thisfile = Dir$(ThisPath + ThisPattern, 0)

List1.Tag = ThisPath
Dim x As Integer
ReDim arrFile(0)
Do While Thisfile <> &quot;&quot;
ReDim Preserve arrFile(x)
arrFile(x) = Thisfile
x = x + 1
On Error Resume Next
char = InStrRev(Right(Thisfile, 5), &quot;.&quot
On Error GoTo 0
Select Case char
Case 1, 2, 3, 4
List1.AddItem Left(Thisfile, Len(Thisfile) - (5 - char + 1))
Case Else
'Unknown extension so add the file to list
List1.AddItem Thisfile
End Select
Thisfile = Dir$
Loop

Exit Sub
1 MsgBox &quot;Drive not reading&quot;

End Sub

 

[Hypetia]

I think the piece of code I am pasting below is closest to what you are looking for. I have tried to merge my code with the existing code without altering it.

So the default, black-colored code is provided by LPlates and the blue-colored code is added by me to meet your requirements. The purpose of coloring is just to emphasize the additions/amendments.

It allows you to add new shortcuts to the listbox by drag/drop and also makes a copy of that shortcut in ...\Common\VSS folder. Moreover, you will be able to invoke newly-added shortcuts by double-clicking just like the way you do this with older shortcuts loaded initially.

I hope that you will fine-tune the code yourself.
___
[tt]
Option Explicit
Dim arrFile() As String
Const SW_SHOWNORMAL = 1
Private Declare Function ShellExecute Lib &quot;shell32.dll&quot; Alias &quot;ShellExecuteA&quot; (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Form_Load()
List1.OLEDropMode = vbOLEDropManual 'enable drag/drop
ListDir &quot;C:\Program Files\Microsoft Visual Studio\Common\VSS&quot;, &quot;*.lnk&quot;
End Sub

Private Sub List1_DblClick()
Dim ExPath
ExPath = List1.Tag & arrFile(List1.ListIndex)
ShellExecute hwnd, &quot;open&quot;, ExPath, vbNullString, vbNullString, SW_SHOWNORMAL
End Sub

Private Sub ListDir(ThisPath As String, ThisPattern As String)
On Error GoTo 1
Dim Thisfile As String
Dim char As String

List1.Clear
If Right$(ThisPath, 1) <> &quot;\&quot; Then ThisPath = ThisPath + &quot;\&quot;
Thisfile = Dir$(ThisPath + ThisPattern, 0)

List1.Tag = ThisPath
Dim X As Integer
ReDim arrFile(0)
Do While Thisfile <> &quot;&quot;
ReDim Preserve arrFile(X)
arrFile(X) = Thisfile
X = X + 1
On Error Resume Next
char = InStrRev(Right(Thisfile, 5), &quot;.&quot
On Error GoTo 0
Select Case char
Case 1, 2, 3, 4
List1.AddItem Left(Thisfile, Len(Thisfile) - (5 - char + 1))
Case Else
'Unknown extension so add the file to list
List1.AddItem Thisfile
End Select
Thisfile = Dir$
Loop

Exit Sub
1 MsgBox &quot;Drive not reading&quot;

End Sub

Private Sub List1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Data.GetFormat(vbCFFiles) Then 'if files are present then
Dim F As Variant
For Each F In Data.Files 'add files to the listbox
Dim S As String, N As Long
N = UBound(arrFile) + 1
ReDim Preserve arrFile(N)
S = Dir$(F)
arrFile(N) = S
FileCopy F, List1.Tag & arrFile(N)
N = InStrRev(S, &quot;.&quot
If N Then S = Left$(S, N - 1)
List1.AddItem S
Next
End If
End Sub

Private Sub List1_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
'if files are dragged then enable copy effect (Pointer with a + sign)
Effect = IIf(Data.GetFormat(vbCFFiles), Effect And vbDropEffectCopy, 0)
End Sub[/tt]

 

[Bubbler]

Thank you so much Hypetia, I did a couple tweaks to the code, but not to fix it or anything, it works great. I really appreciate your help, I know this is not a code library forum, but I really had no idea where to start. Thanks again!

 

[Bubbler]

One quick question, what do I add that will allow the deletion of a highlighted file in the list (delete both the actual file and also the list entry)

 

[Hypetia]

I have seen that you've been asking different question about this program in different threads at different times.

How to add filenames to a list without extension?
How to invoke these files when double-clicked in the list?
How to retrieve the shortcut icons of these files?
And how to enable drag/drop support?

And now you are asking how to delete existing items from the list!

Different people have given you different answers including me and LPlates. This resulted in a complicated code which is a mix of code provided by various people and lacks in harmony and unique coding style. If you have asked all your questions at one place, things would have been simpler, both for you and the people who helped you.

If I had knew about your requirements earlier, I would have suggested you to use collections instead of dynamic arrays because collections are more flexible and elastic then arrays and they have the ability to grow and shrink more easily then arrays. LPlates came up with the suggestion of arrays because he also did not know at that time what would you need in future.

At this stage, arrays are creating a mess.

Anyways here is the 'delete' code you needed, still sticking with the existing 'array-based' code.
___
[tt]
Private Sub cmdDelete_Click()
Dim N As Long, L As Long
N = List1.ListIndex
'exit if no item is selected
If N = -1 Then Exit Sub
'delete the 'copied' shortcut file
Kill List1.Tag & arrFile(N)
'delete the item from the listbox
List1.RemoveItem N
'delete the item from the array
For L = N To List1.ListCount - 1
arrFile(L) = arrFile(L + 1)
Next
'shrink the array by reducing its size, one item less
N = UBound(arrFile)
If N > 0 Then ReDim Preserve arrFile(N - 1)
End Sub[/tt]
___

By the way, did you try to do it yourself? Or you just opened a TT window and posted your question without any effort of your own?

I would suggest you to switch to collections. Although the existing code is also working(hopefully) but the code would become a lot simpler to understand and modify if you use collections instead of arrays. But explore them yourself. No more spoon-feeding in future.

Pardon me if I went rude. I was just trying to nudge you to make you try solving your problems yourself.
After all you must realize how &quot;long&quot; it takes to answer a &quot;One quick question&quot;.

Many thanks for the star --- and goodluck.

 

[johnwm]

Bubbler

Further to Hypetia's penultimate paragraph, please also read faq222-2244, especially paragraphs 8 and 10.

As detailed in the faq, this is supposed to be a site for professionals to exchange thoughts, not a free code shop.

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first

'If we're supposed to work in Hex, why have we only got A fingers?'

 

[Bubbler]

Thank you both for your patience, and to johnwm, do you know of any good free code shops? I only know of one place and it is not that good. Even subscription based ones are fine, I don't mind paying for membership if it is a good site.

Thank you again and in the future I will try to keep in the guidlines

 

[LPlates]

[bold]Hypetia[/bold] I was going to suggest a collection but then didnt want to add confusion after the initial code suggestions were made(which is basically your point)

[bold]Bubbler[/bold] Familiarize yourself with the code, learn how it works then adapt it to allow for a collection instead of array

[bold]johnwm[/bold] Whilst I agree with your comments, surely you can remember a time when you struggled with code and someone gave you some input that not only solved your coding dilema but also gave you motivation and enthusiasm to continue?

P.S. Bubbler, Check out

http://www.planetsourcecode.com,

its a free code site, g/l.

 

[Bubbler]

LPlates I will give PlanetSourceCode.com a try

 

[johnwm]

Lplates

I do indeed remember that time (unfortunately there wasn't much of an Internet then!), but there are plenty of code repository sites around, several of them on our 'Partners' list. The point I was making was that this isn't one of them!

The description of the forum (see bottom of page) is:
<Visual Basic(Microsoft): Version 5 & 6 technical support forum and mutual help system for computer professionals.>

The faq is intended to guide us on use of code posting (amongst others). We all recognise that sometimes a code snippet is required, but we would hope that a professional would only very occassionally need great chunks of code

BTW congrats on getting to the top of the MVP list!

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first

'If we're supposed to work in Hex, why have we only got A fingers?'

 

[LPlates]

johnwm Thanks for the congrats, not sure how that happened!