提取文件名的VBA代码分享，以下为代码及使用方法
（对于需要使用VBA来调用窗口打开文件对话框，选择文件或文件夹，可参考代码修改，服务于自身需求。）
使用方法 （VBA入门教程）
1，新建一个Excel工作簿，另存为.xlsm格式。（office2016版.xlsx格式不支持运行宏，xlsm格式是支持运行宏的文件格式。）
2，点击 开发工具，点击 Visual Basic 打开代码编辑器，双击Sheet1，复制代码，保存。
如果找不到开发工具，则去 Excel选项设置中勾选开发工具。（路径为：文件–更多–选项–自定义功能区–主选项卡–开发工具）
3，点击 开发工具，点击插入，插入 Active X控件 ，选择第一个长方形控件，在空白处绘制控件。（在E列之后，E列之前会挡住文件名数据）绘制好控件后，关闭 设计模式 。（插入控件后会自动开启 设计模式），点击 绘制的好的控件，即可运行程序。
4，或者不绘制控件（即 不进行第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（如有代码使用问题或报错，请留言。）