2014 年 7 月更新:添加PowerShell
选项并削减第二个代码以仅列出文件夹
下面的方法运行完整的递归过程来代替FileSearch
Office 2007 中已弃用。(后面的两个代码仅使用 Excel 进行输出 - 在 Word 中运行时可以删除此输出)
- Shell
PowerShell
- Using
FSO
with Dir
用于过滤文件类型。源自于此EE答案 http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_24901177.html它位于 EE 付费墙后面。这比您要求的(文件夹列表)要长,但我认为它很有用,因为它为您提供了一系列结果以供进一步使用
- Using
Dir
。这个例子来自我在另一个网站上提供的答案
1. 使用PowerShell
将 C:\temp 下面的所有文件夹转储到 csv 文件中
Sub Comesfast()
X2 = Shell("powershell.exe Get-ChildItem c:\temp -Recurse | ?{ $_.PSIsContainer } | export-csv C:\temp\filename.csv", 1)
End Sub
2. 使用FileScriptingObject
将 C:\temp 下面的所有文件夹转储到 Excel 中
Public Arr() As String
Public Counter As Long
Sub LoopThroughFilePaths()
Dim myArr
Dim strPath As String
strPath = "c:\temp\"
myArr = GetSubFolders(strPath)
[A1].Resize(UBound(myArr, 1), 1) = Application.Transpose(myArr)
End Sub
Function GetSubFolders(RootPath As String)
Dim fso As Object
Dim fld As Object
Dim sf As Object
Dim myArr
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(RootPath)
For Each sf In fld.SUBFOLDERS
ReDim Preserve Arr(Counter)
Arr(Counter) = sf.Path
Counter = Counter + 1
myArr = GetSubFolders(sf.Path)
Next
GetSubFolders = Arr
Set sf = Nothing
Set fld = Nothing
Set fso = Nothing
End Function
3 Using Dir
Option Explicit
Public StrArray()
Public lngCnt As Long
Public b_OS_XP As Boolean
Public Enum MP3Tags
' See http://www.kixtart.org/forums/ubbthreads.php?ubb=showflat&Number=160880&page=1 for OS specific attribute lists
XP_Artist = 16
XP_AlbumTitle = 17
XP_SongTitle = 10
XP_TrackNumber = 19
XP_RecordingYear = 18
XP_Genre = 20
XP_Duration = 21
XP_BitRate = 22
Vista_W7_Artist = 13
Vista_W7_AlbumTitle = 14
Vista_W7_SongTitle = 21
Vista_W7_TrackNumber = 26
Vista_W7_RecordingYear = 15
Vista_W7_Genre = 16
Vista_W7_Duration = 17
Vista_W7_BitRate = 28
End Enum
Public Sub Main()
Dim objws
Dim objWMIService
Dim colOperatingSystems
Dim objOperatingSystem
Dim objFSO
Dim objFolder
Dim Wb As Workbook
Dim ws As Worksheet
Dim strobjFolderPath As String
Dim strOS As String
Dim strMyDoc As String
Dim strComputer As String
'Setup Application for the user
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
'reset public variables
lngCnt = 0
ReDim StrArray(1 To 10, 1 To 1000)
' Use wscript to automatically locate the My Documents directory
Set objws = CreateObject("wscript.shell")
strMyDoc = objws.SpecialFolders("MyDocuments")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOperatingSystem In colOperatingSystems
strOS = objOperatingSystem.Caption
Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
If InStr(strOS, "XP") Then
b_OS_XP = True
Else
b_OS_XP = False
End If
' Format output sheet
Set Wb = Workbooks.Add(1)
Set ws = Wb.Worksheets(1)
ws.[a1] = Now()
ws.[a2] = strOS
ws.[a3] = strMyDoc
ws.[a1:a3].HorizontalAlignment = xlLeft
ws.[A4:J4].Value = Array("Folder", "File", "Artist", "Album Title", "Song Title", "Track Number", "Recording Year", "Genre", "Duration", "Bit Rate")
ws.Range([a1], [j4]).Font.Bold = True
ws.Rows(5).Select
ActiveWindow.FreezePanes = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strMyDoc)
' Start the code to gather the files
ShowSubFolders objFolder, True
ShowSubFolders objFolder, False
If lngCnt > 0 Then
' Finalise output
With ws.Range(ws.[a5], ws.Cells(5 + lngCnt - 1, 10))
.Value2 = Application.Transpose(StrArray)
.Offset(-1, 0).Resize(Rows.Count - 3, 10).AutoFilter
.Offset(-4, 0).Resize(Rows.Count, 10).Columns.AutoFit
End With
ws.[a1].Activate
Else
MsgBox "No files found!", vbCritical
Wb.Close False
End If
' tidy up
Set objFSO = Nothing
Set objws = Nothing
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.StatusBar = vbNullString
End With
End Sub
Sub ShowSubFolders(ByVal objFolder, bRootFolder As Boolean)
Dim objShell
Dim objShellFolder
Dim objShellFolderItem
Dim colFolders
Dim objSubfolder
'strName must be a variant, as ParseName does not work with a string argument
Dim strFname
Set objShell = CreateObject("Shell.Application")
Set colFolders = objFolder.SubFolders
Application.StatusBar = "Processing " & objFolder.Path
If bRootFolder Then
Set objSubfolder = objFolder
GoTo OneTimeRoot
End If
For Each objSubfolder In colFolders
'check to see if root directory files are to be processed
OneTimeRoot:
strFname = Dir(objSubfolder.Path & "\*.mp3")
Set objShellFolder = objShell.Namespace(objSubfolder.Path)
Do While Len(strFname) > 0
lngCnt = lngCnt + 1
If lngCnt Mod 1000 = 0 Then ReDim Preserve StrArray(1 To 10, 1 To (lngCnt + 1000))
Set objShellFolderItem = objShellFolder.ParseName(strFname)
StrArray(1, lngCnt) = objSubfolder
StrArray(2, lngCnt) = strFname
If b_OS_XP Then
StrArray(3, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_Artist)
StrArray(4, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_AlbumTitle)
StrArray(5, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_SongTitle)
StrArray(6, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_TrackNumber)
StrArray(7, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_RecordingYear)
StrArray(8, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_Genre)
StrArray(9, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_Duration)
StrArray(10, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_BitRate)
Else
StrArray(3, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_Artist)
StrArray(4, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_AlbumTitle)
StrArray(5, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_SongTitle)
StrArray(6, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_TrackNumber)
StrArray(7, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_RecordingYear)
StrArray(8, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_Genre)
StrArray(9, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_Duration)
StrArray(10, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_BitRate)
End If
strFname = Dir
Loop
If bRootFolder Then
bRootFolder = False
Exit Sub
End If
ShowSubFolders objSubfolder, False
Next
End Sub