Question

我有以下代码从我指定的目录中提取文件名。我在互联网上找到它并将其修改为我需要的工作。

问题是我不希望它弹出一个窗口让我选择一个文件夹 - 我想使用指定的文件夹。如何更改此代码以便我不必使用该窗口，或者如果我无法更改它，我可以对我的情况做些什么？

Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\Desktop" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = Application.DefaultFilePath & "\"
    .Title = "Please select a folder to list Files from"
    .InitialFileName = InitialFoldr$
    .Show
    If .SelectedItems.count <> 0 Then
        xDirect$ = .SelectedItems(1) & "\"
        xFname$ = Dir(xDirect$, 7)
        Do While xFname$ <> ""
            ActiveCell.Offset(xRow) = Left(xFname$, InStrRev(xFname$, ".") - 1)
            xRow = xRow + 1
            xFname$ = Dir
        Loop
    End If
End With

Answer 1

我最终完全改变了我的代码，而不是使用旧代码。再次，我在互联网上找到了一些代码并对其进行了修改，以满足我的需要。

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

Answer 2

这是代码的关键部分：

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

您可以指定任何您想要的路径

Answer 3

在我的Excel-2010上，Kelsius的示例仅适用于目录名中的尾部（右）反斜杠：

FileName = Dir（＆＃34; C：\ Desktop \ ＆＃34;）

这是我的完整示例：

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

使用Excel VBA获取文件夹/目录中的文件名列表

3 个答案: