VBA 将文件拖放到用户表单以获取文件名和路径
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20569959/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA drag and drop file to user form to get filename and path
提问by MattB
I'd like to learn a new trick, but I'm not 100% confident it is possible in VBA, but I thought I'd check with the gurus here.
我想学习一个新技巧，但我不是 100% 有信心在 VBA 中它是可能的，但我想我会在这里咨询大师。
What I'd like to do is eschew the good-old getopenfilename or browser window (it has been really difficult to get the starting directory set on our network drive) and I'd like to create a VBA user form where a user can drag and drop a file from the desktop or a browser window on the form and VBA will load the filename and path. Again, I'm not sure if this is possible, but if it is or if someone has done it before I'd appreciate pointers. I know how to set up a user form, but I don't have any real code outside of that. If there is something I can provide, let me know.
我想做的是避开旧的 getopenfilename 或浏览器窗口（在我们的网络驱动器上设置起始目录真的很难），我想创建一个 VBA 用户表单，用户可以在其中拖动并从桌面或表单上的浏览器窗口拖放文件，VBA 将加载文件名和路径。同样，我不确定这是否可行，但是否可行，或者是否有人在我感谢指点之前已经这样做了。我知道如何设置用户表单，但除此之外我没有任何真正的代码。如果有什么我可以提供的，请告诉我。
Thanks for your time and consideration!
感谢您的时间和考虑！
回答by MattB
I figured out a way to achieve this. As far as I can tell, it can only be done using a treeview control. You may have to right click your toolbox to find and add it. It will be there under "additional controls" or something like that. You'll need two things aside from the control.
我想出了一种方法来实现这一目标。据我所知，它只能使用树视图控件来完成。您可能需要右键单击您的工具箱才能找到并添加它。它将在“附加控制”或类似的东西下。除了控件之外，您还需要两件事。
In the UserForm_Initializesub you will need the following line of code to enable drag and drop: TreeView1.OLEDropMode = ccOLEDropManual:
在UserForm_Initializesub 中，您将需要以下代码行来启用拖放 TreeView1.OLEDropMode = ccOLEDropManual：
UserForm_Initialize()
TreeView1.OLEDropMode = ccOLEDropManual
End Sub
Then you will need the Private Sub TreeView1_OLEDragDropevent. I've omitted all the parameters to save space. They should be easy enough to find. In that sub simply declare a string, maybe strPathor something like that to hold the file name and path and set strPath = Data.Files(1)and that will get the file name and path of a file that the user drags to the TreeView control. This assumes that the user only drags one file at a time, but as far as I can tell this should be something that can be done dragging multiple files if you experiment with it.
然后您将需要该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
Edit: You will also need to add a reference to Microsoft Windows Common Controls 6.0
编辑：您还需要添加对 Microsoft Windows Common Controls 6.0
I've also added example code.
我还添加了示例代码。
回答by Krish
I know this is an old thread. Future readers, If you are after some cool UI, you can checkout my Githubfor sample database using .NET wrapper dll. Which allows you to simply call a function and to open filedialog with file-drag-and-dropfunction. Result is returned as a JSONArray string.
我知道这是一个旧线程。未来的读者，如果您想要一些很酷的 UI，您可以使用 .NET 包装器 dll 查看我的Github以获取示例数据库。这允许您简单地调用一个函数并使用文件拖放功能打开文件对话框。结果作为 JSONArray 字符串返回。
code can be simple as
代码可以很简单
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
here what it looks like;
这是它的样子；
回答by Dalton Coker
I got it to work by using Application Event WorkbookOpen. When a file gets dragged onto an open Excel Sheet it will try to open that file in Excel as a separate workbook which would trigger the above event. It's a bit of a pain but I used this link https://bettersolutions.com/vba/events/excel-application-level-events.htmas a reference.
我通过使用 Application Event WorkbookOpen 让它工作。当文件被拖到打开的 Excel 工作表上时，它会尝试在 Excel 中将该文件作为单独的工作簿打开，这将触发上述事件。这有点痛苦，但我使用此链接https://bettersolutions.com/vba/events/excel-application-level-events.htm作为参考。
Only issue is that if the file isn't an Excel file then it will have a popup and you can't run a VBScript to get rid of it since the Event won't run until you address the popup. A portion of my code below:
唯一的问题是，如果该文件不是 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
Edit: Forgot that you need to initialize the Application Events by posting the below code in any module
编辑：忘记了您需要通过在任何模块中发布以下代码来初始化应用程序事件
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
And then paste this code in ThisWorkbook Workbook_Open()
然后将此代码粘贴到 ThisWorkbook Workbook_Open()
'Initialize the Application Events
Application.OnTime Now, "'" & ThisWorkbook.FullName & "'!Init"
