我想学习一个新技巧，但我不是 100% 确信它在 VBA 中是可能的，但我想我会在这里与大师核实一下。
我想做的是避开旧的 getopenfilename 或浏览器窗口（在我们的网络驱动器上设置起始目录真的很困难），我想创建一个 VBA 用户表单，其中用户可以从桌面或表单上的浏览器窗口拖放文件，VBA 将加载文件名和路径。同样，我不确定这是否可能，但如果是这样，或者是否有人在我感激指针之前已经做到了。我知道如何设置用户表单，但除此之外我没有任何真正的代码。如果有什么我可以提供的，请告诉我。
感谢您的时间和考虑！
【问题讨论】：
标签： excel vba drag-and-drop userform
我想出了一个方法来实现这一点。据我所知，它只能使用树视图控件来完成。您可能必须右键单击您的工具箱才能找到并添加它。它将在“附加控制”或类似的东西下。除了控件之外，您还需要两件事。
在UserForm_Initialize 子中，您需要以下代码行来启用拖放：TreeView1.OLEDropMode = ccOLEDropManual：
UserForm_Initialize()
TreeView1.OLEDropMode = ccOLEDropManual
End Sub
然后您将需要Private Sub TreeView1_OLEDragDrop 事件。我省略了所有参数以节省空间。它们应该很容易找到。在那个 sub 中简单地声明一个字符串，可能是strPath 或类似的东西来保存文件名和路径并设置strPath = Data.Files(1)，这将获得用户拖动到 TreeView 控件的文件的文件名和路径。这假设用户一次只拖动一个文件，但据我所知，如果您尝试一下，这应该是可以拖动多个文件的事情。
Private Sub TreeView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
StrPath = Data.Files(1)
End Sub
编辑：您还需要添加对Microsoft Windows Common Controls 6.0的引用
我还添加了示例代码。
【讨论】：
Data.Files(1) 获取文件名的原因。我没有对此进行测试，所以我不能保证任何事情，但我假设您可以遍历 Data.Files(1 to n) 数组以获取多个文件路径。试试For intCounter = 1 to UBound(Data.Files) 之类的东西，其中intCounter 是一个整数，然后使用strPath = Data.Files(intCOunter) 检索所有文件路径。应该工作。
For Each dataFile In Data.Files
我知道这是一个旧线程。未来的读者，如果您想要一些很酷的 UI，您可以查看我的 Github 以获取使用 .NET 包装器 dll 的示例数据库。它允许您简单地调用一个函数并使用 file-drag-and-drop 函数打开文件对话框。结果以 JSONArray 字符串形式返回。
代码可以很简单
Dim FilePaths As String
FilePaths = gDll.DLL.ShowDialogForFile("No multiple files allowed", False)
'Will return a JSONArray string.
'Multiple files can be opend by setting AllowMulti:=true
这里是什么样子的；
【讨论】：
我通过使用 Application Event WorkbookOpen 让它工作。当文件被拖到打开的 Excel 工作表上时，它将尝试在 Excel 中将该文件作为单独的工作簿打开，这将触发上述事件。这有点痛苦，但我使用此链接https://bettersolutions.com/vba/events/excel-application-level-events.htm 作为参考。
唯一的问题是，如果文件不是 Excel 文件，那么它将有一个弹出窗口，并且您无法运行 VBScript 来摆脱它，因为在您解决弹出窗口之前事件不会运行。下面是我的部分代码：
Public WithEvents App As Application
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Dim path, pathExt As String
path = Wb.Name
pathExt = Mid(path, InStrRev(path, "."))
If pathExt = ".pdf" Then
Application.DisplayAlerts = False
Workbooks(Wb.Name).Windows(1).Visible = False
Dim n As String
n = Wb.FullName
Wb.Close
Call DragnDrop.newSheet(n)
Application.DisplayAlerts = True
End If
End Sub
编辑： 忘记了您需要通过在任何模块中发布以下代码来初始化应用程序事件
Option Explicit
'Variable to hold instance of class clsApp
Dim mcApp As clsApp
Public Sub Init()
'Reset mcApp in case it is already loaded
Set mcApp = Nothing
'Create a new instance of clsApp
Set mcApp = New clsApp 'Whatever you named your class module
'Pass the Excel object to it so it knows what application
'it needs to respond to
Set mcApp.App = Application 'mcApp.Whatever you named this Public
'WithEvents App As Application
End Sub
然后将此代码粘贴到 ThisWorkbook Workbook_Open() 中
'Initialize the Application Events
Application.OnTime Now, "'" & ThisWorkbook.FullName & "'!Init"
【讨论】：