VBA拖放文件到用户窗体以获取文件名和路径

14

我想学习一个新技巧,但我不100%确信它在VBA中是否可行,所以我想在这里向大牛们请教一下。

我的目标是避免使用传统的getopenfilename或browser窗口(在我们的网络驱动器上设置起始目录非常困难),并创建一个VBA用户表单,在其中用户可以从桌面或浏览器窗口将文件拖放到表单上,然后VBA将加载文件名和路径。同样,我不确定这是否可行,但如果可能或有人之前已经做过,我会感谢任何指导。我知道如何设置用户表单,但除此之外我没有任何真正的代码。如果需要提供其他信息,请告诉我。

感谢您抽出时间和考虑!


2
找到了答案并回答了自己的问题,Downboats先生,不管你是谁。 - MattB
3个回答

24

我找到了一种实现这个的方法。据我所知,只能使用treeview控件来完成。您可能需要右键单击工具箱以查找并添加它。它将在“其他控件”或类似名称下面。除了控件之外,您还需要两样东西。

UserForm_Initialize子程序中,您需要以下代码行来启用拖放:TreeView1.OLEDropMode = ccOLEDropManual

UserForm_Initialize()
    TreeView1.OLEDropMode = ccOLEDropManual
End Sub

那么您需要使用Private Sub TreeView1_OLEDragDrop事件。我省略了所有的参数以节省空间。它们应该很容易找到。在这个子程序中,只需声明一个字符串,比如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公共控制6.0 的引用。

我还添加了示例代码。


1
谢谢,这很有用!我不明白为什么有人会给你一个负分... 这真的很烦人。 - JoaMika
你可以发布一些用于用户拖拽多个文件的代码吗? - JoaMika
1
@JoannaMikalai 我实际上还没有使用多个文件来完成,但我认为这是可能的。我会给出我的最佳猜测。DragDrop事件生成数据.files对象,该对象从1开始索引。这就是为什么我使用Data.Files(1)来获取文件名的原因。我还没有测试过,所以不能保证什么,但我认为您可以遍历Data.Files(1到n)数组以获取多个文件路径。尝试像这样使用For intCounter = 1 to UBound(Data.Files),其中intCounter是一个整数,并使用strPath = Data.Files(intCOunter)检索所有文件路径。应该可以工作。 - MattB
Matt的解决方案非常好,只需要确保:需要添加支持OLEDragDrop操作的TreeView控件:右键单击工具箱区域显示所有可用控件。 选择“其他控件…” 包括:“Microsoft TreeView控件,版本6.0” - Mor Sagmon
For Each dataFile In Data.Files - HackSlash

1
我知道这是一个旧的线程。如果你想要一些酷炫的用户界面,你可以查看我的 Github,里面有使用 .NET 封装程序库的样本数据库。它允许你仅调用一个函数来打开文件对话框,并带有文件拖放功能。结果以 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

这是什么样子;

In Action


这是一个非常酷的项目。我认为它被贬低了,因为它不是本地解决方案,但这是一个不错的想法。 - HackSlash
嗨Krish!为这个酷项目点赞。我想知道它是否可行用于分发目的? - VBAbyMBA

0

我通过使用应用程序事件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"

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接