时间戳

首页 > 解决方案 > 从目录中插入选定的文件名/路径

excel - 从目录中插入选定的文件名/路径

问题描述

我想在一张纸上构建一个来自不同路径的选定文件列表。

在“A”列中，我有文件名（带有扩展名），在“B”列中，我有文件路径。

我想打开一个目录，突出显示该目录中的特定文件，并将它们的文件名和路径分别复制到 A 列和 B 列中的下一个可用行中。

我可以导入给定文件夹中所有文件的文件名和路径（如下所示），但我想选择特定文件来填充工作表，并粘贴到下一个可用行。

Sub GetFileNames()

    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim i As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    ActiveSheet.Cells(1, 1) = "FileName"
    ActiveSheet.Cells(1, 2) = "FilePath"
    i = 1
    For Each xFile In xFolder.Files
        i = i + 1
        ActiveSheet.Cells(i, 1) = xFile.Name
        ActiveSheet.Cells(i, 2) = xPath
    Next

End Sub

标签： excelvbadirectory

解决方案

只需为 FilePicker 添加另一个 FileDialog。允许它有多个选择。

Option Explicit

Sub GetFileNames()

    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim i As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    ' if headings not equal to this then clear page and set to this
    ActiveSheet.Cells(1, 1) = "FileName"
    ActiveSheet.Cells(1, 2) = "FilePath"
    i = 1       ' needs to be last used line

    Set xFiDialog = Application.FileDialog(msoFileDialogFilePicker)
    With xFiDialog
        .InitialFileName = xPath
        .Filters.Clear      ' Clear all the filters (if applied before).
        .Title = "Select 1 or more Files by holding down CTRL" ' Give the dialog box a title
        .Filters.Add "Files", "*.*", 1  ' show only a particular type of files.
        .AllowMultiSelect = True    ' allow users to select more than one file.

        ' Show the file.
        If .Show = True Then
            'Debug.Print "===="
            'Debug.Print .SelectedItems(1)           ' Get the complete file path.
            'Debug.Print Dir(.SelectedItems(1))      ' Get the file name.
            'Debug.Print "--"
            Dim j As Long
            For j = 1 To .SelectedItems.Count
               'Debug.Print .SelectedItems(j)
               i = i + 1
               ActiveSheet.Cells(i, 1) = .SelectedItems(j)
               ActiveSheet.Cells(i, 2) = xPath
            Next j
        End If
    End With


End Sub

推荐阅读