一、文件名批量导入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