Question

VB如果将list表格中的一组文件（路径+文件名）拖放到资源管理器中？

有个list控件，定义OLEDragMODE 方式为1
填入路径+文件名一组
定义list可以选择多个项目
选择一组选项，怎样将该文件序列拖放拷贝到资源管理器中？
请高手指教，能有详细说明更佳！
谢谢！
我已经找到一个比较简单的解决办法，vb6.0下通过了！
具体如下：
'如果拖放文件
Private Sub List1_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
Dim f As String
Dim i As Long

Data.SetData , vbCFFiles '定义文件类型
For i = 1 To List1.ListCount
If List1.Selected(i) Then '如果该条被选中
f = 找到文件目录(文件名查找指针(i)) & 找到文件名称(文件名查找指针(i))
Data.Files.Add f '添加文件
End If
Next i
End Sub

不过还是非常感谢您的热心解答！

Answer 1

'一、新建一个模块，复制下面代码到模块中
Option Explicit
Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "User32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetParent Lib "User32" (ByVal hWnd As Long) As Long

Private Type POINTAPI
X As Long
Y As Long
End Type

Function GetPath() As String
Dim lu_POINT As POINTAPI, Curwindow As Long, parentWnd As Long
Dim S As String, Hwd As Long, i As Integer
Dim oShellApp, oShellAppWindows, oWin

Call GetCursorPos(lu_POINT)
Curwindow = WindowFromPoint(lu_POINT.X, lu_POINT.Y)
parentWnd = GetParent(Curwindow)
Do While parentWnd <> 0
Curwindow = GetParent(parentWnd)
If Curwindow = 0 Then Exit Do
parentWnd = Curwindow
Loop
Hwd = parentWnd

Set oShellApp = CreateObject("Shell.Application")
Set oShellAppWindows = oShellApp.Windows
For Each oWin In oShellAppWindows
Debug.Print TypeName(oWin.Document)
If TypeName(oWin.Document) = "IShellFolderViewDual2" Then
If oWin.hWnd = Hwd Then
S = oWin.LocationURL
S = Replace(S, "file:///", "", , , vbTextCompare)
S = Replace(S, "/", "\")
S = Replace(S, "%20", " ")
GetPath = S
Exit Function
End If
End If
Next
Set oWin = Nothing
Set oShellApp = Nothing
Set oShellAppWindows = Nothing
End Function

'二、当一个对象拖动到资源管理器后 ，调用下面函数即可完成复制文件工作：

Private Sub List1_OLECompleteDrag(Effect As Long)
Dim i As Integer, S As String
Dim Path As String
Path = GetPath
With List1
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
S = .List(i)
FileCopy S, Path & Path & Mid(S, InStrRev(S, "\"))
End If
DoEvents
Next
End With
MsgBox "文件复制完毕！"
End Sub