VBA获取文件夹下所有文件名或者文件夹名
1，新建excel宏
2，在sheet中添加宏执行按钮
3，设置按钮执行的代码名
VBA代码如下：
'选择文件按钮程序 Private Sub CommandButton1_Click() Application.ScreenUpdating = False Call Choose Application.ScreenUpdating = True End Sub '文件或文件夹选择程序 Sub Choose() Dim Value% Value = MsgBox("选择 文件 还是 文件夹 ？" & Chr(10) & Chr(10) & "是，选择文件" & Chr(10) & "否，选择文件夹", vbYesNoCancel + vbQuestion + vbDefaultButton1, "请选择") If Value = vbYes Then Call FilePicker ElseIf Value = vbNo Then Call FolderPicker Else End End If End Sub '选择文件程序（选择文件的方式提取文件名程序） Sub FilePicker() Dim i&, Item, Rng With Application.FileDialog(msoFileDialogFilePicker) .Title = "请选择文件" .ButtonName = "确定" If .Show = -1 Then ReDim Item(1 To .SelectedItems.Count, 1 To 5) For i = 1 To .SelectedItems.Count Item(i, 1) = i Item(i, 2) = .SelectedItems(i) Next Else Exit Sub End If End With Entering Item End Sub '选择文件夹程序（选择文件夹的方式提取文件名程序） Sub FolderPicker() Dim Path$, i&, j&, Item, arr(), Rng, iFSO, iFolder With Application.FileDialog(msoFileDialogFolderPicker) .Title = "请选择文件夹" .ButtonName = "确定" If .Show = -1 Then Path = .SelectedItems(1) & IIf(Right(.SelectedItems(1), 1) = "\", "", "\") Else Exit Sub End If End With Set iFSO = CreateObject("Scripting.FileSystemObject") Set iFolder = iFSO.GetFolder(Path) i = 1 ReDim Preserve arr(1 To 1000) GetAllFiles iFolder, arr, i ReDim Item(1 To UBound(arr), 1 To 5) For j = 1 To UBound(arr) If arr(j) <> "" Then Item(j, 1) = j Item(j, 2) = arr(j) Else Exit For End If Next Entering Item End Sub '遍历文件夹提取文件名程序 Sub GetAllFiles(ByVal iFolder, arr, i&) Dim iFile, iSubFolder For Each iFile In iFolder.Files If i > UBound(arr) Then ReDim Preserve arr(1 To 1000 + i) arr(i) = iFile.Path i = i + 1 Next If iFolder.SubFolders.Count = 0 Then Exit Sub For Each iSubFolder In iFolder.SubFolders GetAllFiles iSubFolder, arr, i Next End Sub '文件名录入程序 Sub Entering(ByVal Item) On Error Resume Next Dim Rng, i& For i = 1 To UBound(Item) Item(i, 3) = Right(Item(i, 2), Len(Item(i, 2)) - InStrRev(Item(i, 2), "\")) '文件名带后缀 Item(i, 4) = Left(Item(i, 3), InStrRev(Item(i, 3), ".") - 1) '文件名不带后缀 Item(i, 5) = Right(Item(i, 2), Len(Item(i, 2)) - InStrRev(Item(i, 2), ".") + 1) '文件后缀 Next Range("A1").Resize(UBound(Item), 5) = Item '文件名录入 End Sub
把上面代码添加到宏中，设置按钮，就可以获取文件夹名，或者文件夹下所有文件名
