提取文件夹名称VBA

nnsea

Sub FileDir()

    Dim p$, f$, k&

        '获取用户选择文件夹的路径

    With Application.FileDialog(msoFileDialogFolderPicker)

   '选择文件夹

        .AllowMultiSelect = False

        '不允许多选

        If .Show Then

            p = .SelectedItems(1)

            '选择的文件路径赋值变量P

        Else

            Exit Sub

            '如果没有选择保存路径，则退出程序

        End If

    End With

    If Right(p, 1) <> "\" Then p = p & "\"

    f = Dir(p & "*.*")

    '返回变量P路径下带任意扩展名的文件名。如果超过一个文件存在，函数将返回按条件第一个找到的文件名。

    '如果一个文件都没有，则f返回""

    [a:a].ClearContents '清空A列数据

    [a1] = "目录"

    k = 1 'K

    Do While f <> "" '如果f不等于""，则……

        k = k + 1 '累加K

        Cells(k, 1) = f

        f = Dir

        ' 若第二次调用 Dir 函数，但不带任何参数，则将返回同一目录下的下一个文件。

    Loop

    MsgBox "OK"

End Sub