如何把文件名批量导入Excel

一、文件名批量导入Excel

需要导入的文件名较少时，手动输入导入Excel可能是可行的。但如果需要导入的文件名数量非常多的时候，手动输入将非常耗费时间。这时可以使用VBA宏代码来实现文件名的批量导入Excel。

下面是一个VBA宏代码示例，用于批量导入当前文件夹下的文件名到Excel表格中。

Sub FileNameToExcel()
    Dim MyPath As String
    Dim MyName As String
    Dim MyExtension As String
    Dim FldrPicker As FileDialog
    Dim xRow As Long
    xRow = 1
    Application.ScreenUpdating = False
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
        .Title = "Select a folder"
        .AllowMultiSelect = False
        If .Show = -1 Then
            MyPath = .SelectedItems(1) & "\"
        Else
            Exit Sub
        End If
    End With
    MyName = Dir(MyPath & "*.*")
    Do While MyName  ""
        If MyName  "." And MyName  ".." Then
            MyExtension = Right(MyName, Len(MyName) - InStrRev(MyName, ".", , 1))
            If MyExtension = "xls" Or MyExtension = "xlsx" Or MyExtension = "xlsm" Then
                xRow = xRow + 1
                Cells(xRow, 1) = MyName
            End If
        End If
        MyName = Dir
    Loop
    MsgBox "File names in the folder " & MyPath & " have been successfully exported to Excel!", vbInformation, "Export Complete"
End Sub

二、将文件夹里的文件名批量导入Excel

不仅可以将当前文件夹下的文件名导入Excel，还可以将指定文件夹下的文件名导入Excel。下面是一个示例代码，用于将指定文件夹下的文件名批量导入Excel表格中：

Sub FileNameToExcelFolder()
  Dim MyPath As String
  Dim MyName As String
  Dim MyExtension As String
  Dim FldrPicker As FileDialog
  Dim xRow As Long
  xRow = 1
  Application.ScreenUpdating = False
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
  With FldrPicker
      .Title = "Select a folder"
      .AllowMultiSelect = False
      If .Show = -1 Then
          MyPath = .SelectedItems(1) & "\"
      Else
          Exit Sub
      End If
  End With
  MyName = Dir(MyPath & "*.*")
  Do While MyName  ""
      If MyName  "." And MyName  ".." Then
         MyExtension = Right(MyName, Len(MyName) - InStrRev(MyName, ".", , 1))
         If MyExtension = "xls" Or MyExtension = "xlsx" Or MyExtension = "xlsm" Then
            xRow = xRow + 1
            Cells(xRow, 1) = MyName
         End If
      End If
      MyName = Dir
  Loop
  MsgBox "File names in the folder " & MyPath & " have been successfully exported to Excel!", vbInformation, "Export Complete"
End Sub

三、怎么把图片的文件名批量导入Excel

除了导入工作簿文件的文件名，还可以将图片文件的文件名批量导入Excel表格中。下面的代码将导入指定文件夹下的所有图片文件名，不包括子文件夹。

Sub GetPicDoc()
    Application.ScreenUpdating = False
    Dim MyFolder As String
    Dim MyFile As String
    Dim PicList()
    Dim i As Long
    MyFolder = GetFolder()
    If MyFolder = "" Then Exit Sub
    MyFile = Dir(MyFolder & "\*.*")
    Do While MyFile  ""
        If InStr(1, MyFile, ".bmp", vbTextCompare) > 0 Or InStr(1, MyFile, ".jpg", vbTextCompare) > 0 Or InStr(1, MyFile, ".jpeg", vbTextCompare) > 0 Or InStr(1, MyFile, ".gif", vbTextCompare) > 0 Or InStr(1, MyFile, ".png", vbTextCompare) > 0 Then
            i = i + 1
            ReDim Preserve PicList(1 To i)
            PicList(i) = MyFile
        End If
        MyFile = Dir
    Loop
    If i > 0 Then
        Range("A1").Resize(i) = Application.Transpose(PicList)
    Else
        MsgBox "No picture in the folder!"
    End If
    Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
    Dim fldr As FileDialog
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        If .Show = -1 Then
            GetFolder = .SelectedItems(1)
        Else
            GetFolder = ""
        End If
    End With
    Set fldr = Nothing
End Function

四、Word文件名批量导入Excel

除了导入Excel文件的文件名，还可以将Word文件的文件名批量导入Excel表格中。下面的代码将导入指定文件夹下的所有Word文件名，不包括子文件夹。

Sub WordFileNamesToExcel()
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim strFolderPath As String
    Dim strDocName As String
    Dim i As Integer
    Dim lRow As Long
    lRow = 1
    strFolderPath = GetFolder()
    If strFolderPath = "" Then Exit Sub
    Set wdApp = New Word.Application
    wdApp.Visible = False
    With Application.FileSearch
        .NewSearch
        .LookIn = strFolderPath
        .SearchSubFolders = False
        .FileType = msoFileTypeWordDocuments
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                strDocName = .FoundFiles(i)
                Set wdDoc = wdApp.Documents.Open(strDocName, ReadOnly:=True)
                lRow = lRow + 1
                Cells(lRow, 1) = strDocName
                wdDoc.Close SaveChanges:=False
            Next i
        Else
            MsgBox "No Word files found in the folder!"
            Exit Sub
        End If
    End With
    Set wdApp = Nothing
End Sub

五、如何把文件名导入Excel

上述代码是将指定文件夹下特定类型的文件名导入到Excel，如果需要将所有类型的文件名都导入Excel怎么办？

下面的代码将导入指定文件夹下所有类型的文件名，不包括子文件夹。

Sub AllFileNamesToExcel()
    Dim MyFolder As String
    Dim MyFile As String
    Dim FileList()
    Dim i As Long
    MyFolder = GetFolder()
    If MyFolder = "" Then Exit Sub
    MyFile = Dir(MyFolder & "\*.*")
    Do While MyFile  ""
        If MyFile  "." And MyFile  ".." Then
            i = i + 1
            ReDim Preserve FileList(1 To i)
            FileList(i) = MyFile
        End If
        MyFile = Dir
    Loop
    If i > 0 Then
        Range("A1").Resize(i) = Application.Transpose(FileList)
    Else
        MsgBox "No file in the folder!"
    End If
End Sub

六、文件夹名批量导入Excel

如果需要将所有文件夹的文件名都导入Excel怎么办？下面是一个VBA宏代码示例，用于将指定文件夹下的所有文件夹名批量导入Excel表格中。

Sub FolderNameToExcel()
    Cells(1, 1).Value = "Folder Path"
    Cells(1, 2).Value = "Folder Name"
    Call RecurseFolder(FolderPicker(), 1)
End Sub

Sub RecurseFolder(strFolder As String, iRow As Integer)
    Dim fso As Object
    Dim fld As Object
    Dim subFld As Object
    Dim strSubFldName As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(strFolder)
    For Each subFld In fld.SubFolders
        iRow = iRow + 1
        Cells(iRow, 1).Value = subFld.Path
        Cells(iRow, 2).Value = subFld.Name
        Call RecurseFolder(subFld.Path, iRow)
    Next subFld
    Set subFld = Nothing
    Set fld = Nothing
    Set fso = Nothing
End Sub

Function FolderPicker() As String
    Dim fldr As FileDialog
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        If .Show = -1 Then
            FolderPicker = .SelectedItems(1)
        Else
            FolderPicker = ""
        End If
    End With
    Set fldr = Nothing
End Function

七、怎么把文件名弄成Excel表

如果需要将所有文件名都导入Excel，并且按照一定的格式展示怎么办？下面是一个VBA宏代码示例，用于将指定文件夹下所有文件名批量导入到Excel表中，并对它们进行排序、筛选和统计分析。

Sub FileListToExcel()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MyFolder As String
    Dim MyFile As String
    Dim iRow As Long
    MyFolder = GetFolder()
    If MyFolder = "" Then Exit Sub
    Set wb = Workbooks.Add
    Set ws = wb.Sheets(1)
    ws.Name = "File List"
    ws.Cells(1, 1).Value = "File Name"
    iRow = 2
    MyFile = Dir(MyFolder & "\*.*")
    Do While MyFile  ""
        If MyFile  "." And MyFile  ".." Then
            ws.Cells(iRow, 1).Value = MyFile
            iRow = iRow + 1
        End If
        MyFile = Dir
    Loop
    ws.Columns("A:A").AutoFit
    ws.Range("A1").AutoFilter
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=ws.Range("A2:A" & iRow), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.Sort.SetRange ws.Range("A1:A" & iRow)
    ws.Sort.Header = xlYes
    ws.Sort.MatchCase = False
    ws.Sort.Orientation = xlTopToBottom
    ws.Sort.SortMethod = xlPinYin
    ws.Sort.Apply
    MsgBox "File names in the folder " & MyFolder & " have been successfully exported to Excel!", vbInformation, "Export Complete"
End Sub