我最终完全改变了我的代码，没有使用旧的代码。再次，我在互联网上找到了一些代码，并修改了它，以满足我的需要。

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
Dim rng As Range
Dim Idx As Integer

FileCount = 0
FileName = Dir("C:\Desktop")

'   Loop until no more matching files are found
Do While FileName <> ""
    FileCount = FileCount + 1
    ReDim Preserve FileArray(1 To FileCount)
    FileArray(FileCount) = FileName
    FileName = Dir()
Loop
GetFileList = FileArray
Set rng = ActiveCell
For Idx = 0 To FileCount - 1
    ActiveCell.Offset(Idx, 0).Value = Left(FileArray(Idx + 1), InStrRev(FileArray(Idx + 1), ".") - 1)
Next Idx

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

这是代码的关键部分：

xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
    ActiveCell.Offset(xRow) = Left(xFname$, InStrRev(xFname$, ".") - 1)
    xRow = xRow + 1
    xFname$ = Dir
Loop

如果将该块中的第一行更改为

xDirect$ = My_Path_With_Trailing_Slash

可以指定所需的任何路径

在我的Excel-2010中，Kelsius的例子只适用于目录名称中的尾随（右）反斜杠：
FileName = Dir（“C：\Desktop******”）
这是我的完整示例：

Public Sub ReadFileList()
Dim bkp As String

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
Dim Idx As Integer
Dim rng As Range

    bkp = "E:\Flak\TRGRES\1\"

    If bkp <> "" Then
        FileCount = 0
        FileName = dir(bkp)

        Do While FileName <> ""
            Debug.Print FileName

            FileCount = FileCount + 1
            ReDim Preserve FileArray(1 To FileCount)
            FileArray(FileCount) = FileName
            FileName = dir()
        Loop
    End If
End Sub

第一段代码在我的情况下很有用。但是我修改了它，所以它可能对其他人有帮助。

Sub SelectAndListFiles()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\Desktop" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = Application.DefaultFilePath & "\"
    .Title = "Please select a folder to list Files from"
    .InitialFileName = InitialFoldr$
    .Show
   If .SelectedItems.Count <> 0 Then
        xDirect$ = .SelectedItems(1)
        ActiveCell = Left(xDirect$, InStrRev(xDirect$, "\")) 'enter path in cell
        xRow = 1
        For n = 1 To .SelectedItems.Count
            xDirect$ = .SelectedItems(n)
            xFname$ = Dir(xDirect$, vbNormal)         'list all selected files
            ActiveCell.Offset(xRow) = xFname$
            xRow = xRow + 1
        Next n
    End If
End With
End Sub