整体思路:传递文件夹名称、Sheet名称、列和行的数字自动获取该文件夹下的文件名称
'+------------------------------------------------------------
'| 获取指定文件夹下的文件列表
'+------------------------------------------------------------
Public Sub autoListFileName(ByVal FolderName As String, ByVal SheetName As String, ByVal Column As Integer, ByVal StartRow As Integer)
On Error Resume Next
'关闭屏幕更新
Application.ScreenUpdating = False
'定义变量
Dim intFiles As Integer '文件总数
Dim i As Integer '遍历当前数
Dim myfso As Object
Dim myfile
Dim mypath
Dim sh As Variant
'变量赋值
i = 0
'建立这个文件处理对象
Set myfso = CreateObject("Scripting.FileSystemObject")
'取得这个文件夹下的所有文件
Set myfile = myfso.GetFolder(ThisWorkbook.Path & "\" & FolderName).Files
'取得文件夹下文件数量
intFiles = myfso.GetFolder(ThisWorkbook.Path & "\" & FolderName).Files.Count
'遍历查找并复制
For Each sh In myfile
ThisWorkbook.Worksheets(SheetName).Cells(StartRow + i, Column).Value = sh.Name
i = i + 1
Next
'清空资源
Set myfso = Nothing
'恢复屏幕更新
Application.ScreenUpdating = True
End Sub
在具体需要提取页面中,使用双击事件启动方法
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
'双击定位统计录音数量
If Target.Row = 6 And Target.Column = 1 Then
Cancel = True '退出单元格编辑状态
Call autoListFileName("调研问卷", "DATA", 1, 7) '自动获取图片库下文件列表
End If
End Sub