如何把文件名批量導入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