如何计算文件夹中的文件
How can I count files in folder
我想统计 Excel VBA 文件夹中的文件数。
现在速度对我来说非常重要，所以首先我将所有文件（从文件夹和子文件夹）列出到“A”列，我想遍历所有行并计算文件夹中有多少文件。
我的“A”列列表：
D:\Steam\libraryfolder.vdf
D:\Steam\steam.dll
D:\Steam\config\appconfig.json
D:\Steam\config\chaperone_info.vrchap
D:\Steam\config\steamvr.vrsettings
D:\Steam\config\lighthouse\lighthousedb.json
D:\Steam\config\lighthouse\lhr-eebe0f79\config.json
D:\Steam\config\lighthouse\lhr-eebe0f79\userdata\Green_46GA163X002581_mura_analyzes.mc
D:\Steam\config\lighthouse\lhr-eebe0f79\userdata\Green_46HA163P000228_mura_analyzes.mc
我想获取“B”列的文件数。
所以“B”列应该如下所示：
2
2
3
3
3
1
1
2
2
目前我有这个小代码来计算“”，但不幸的是我不知道如何计算文件。
Sub test()
Dim S As String
S = "D:\Steam\config\lighthouse\lhr-eebe0f79\config.json"
MsgBox "count = " & UBound(Split(S, "\"))
End Sub
为此您不需要 VBA，标准 Excel 函数可以计算这些计数。
B 列用于从路径中提取文件名：
=MID(A1,FIND("*",SUBSTITUTE(A1,"\","*",LEN(A1)-LEN(SUBSTITUTE(A1,"\",""))))+1,LEN(A1))
然后使用C列提取路径：
=LEFT(A1,LEN(A1)-LEN(B1))
最后，D列可以统计同一目录下的文件数：
=COUNTIF(C:C,$C1)
如果您确实需要在 VBA 中执行此操作，那么这里有几个函数可以在给定完整路径的情况下提取文件名或目录：
' Returns the file name given a full file path
Function BaseName(FilePath)
BaseName = Mid(FilePath, InStrRev(FilePath, "\") + 1)
End Function
' Returns the directory path given a full file path
Function DirName(FilePath)
DirName = Mid(FilePath, 1, Len(FilePath) - Len(BaseName(FilePath)))
End Function
从文件路径列表中计算文件夹中的文件数
- 给定的文件路径列表在
A2:A20. 中
- 第一个过程的结果
CountFilesPerFolder 在 B2:B20 中。
- 第二个过程的结果
ListFilesCountPerFolder 在 E2:F8 中。
获取文件夹路径的Excel公式(Evaluate)
=LEFT(A2,FIND("*",SUBSTITUTE(A2,"\","*",LEN(A2)-LEN(SUBSTITUTE(A2,"\",""))))-1)
代码
Option Explicit
Sub CountFilesPerFolder()
' Source
Const sCol As String = "A"
' Destination
Const dCol As String = "B"
' Both
Const fRow As Long = 2
' Reference the worksheet.
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
' Reference the one-column range containing the file paths by using
' the End property to calculate the last row.
Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
Dim rCount As Long: rCount = slRow - fRow + 1
If rCount < 1 Then Exit Sub ' column range is empty
Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(rCount)
Dim sAddress As String: sAddress = srg.Address
' Write the folder paths to an array by using the Evaluate method.
Dim Data As Variant
Data = ws.Evaluate("LEFT(" & sAddress & ",FIND(""*"",SUBSTITUTE(" _
& sAddress & ",""\"",""*"",LEN(" & sAddress & ")-LEN(SUBSTITUTE(" _
& sAddress & ",""\"",""""))))-1)")
' Write the folder paths from the array to the keys of a dictionary
' using its items to count the files.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Variant
Dim r As Long
For r = 1 To rCount
Key = Data(r, 1)
If Not IsError(Key) Then
If Len(Key) > 0 Then
dict(Key) = dict(Key) + 1
End If
End If
Next r
If dict.Count = 0 Then Exit Sub ' only blanks and error values
' Write the files count from the items of the dictionary
' to the array (overwriting the folder paths).
For r = 1 To rCount
Key = Data(r, 1)
If dict.Exists(Key) Then
Data(r, 1) = dict(Key)
Else
Data(r, 1) = Empty
End If
Next r
' Write the files count from the array to the destination one-column range
' and clear the contents below.
With srg.EntireRow.Columns(dCol)
.Resize(rCount).Value = Data
.Resize(ws.Rows.Count - .Row - rCount + 1).Offset(rCount).ClearContents
End With
End Sub
Sub ListFilesCountPerFolder()
' Source
Const sCol As String = "A"
' Destination
Const dCol As String = "E"
' Both
Const fRow As Long = 2
' Reference the worksheet.
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
' Reference the one-column range containing the file paths by using
' the End property to calculate the last row.
Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
Dim rCount As Long: rCount = slRow - fRow + 1
If rCount < 1 Then Exit Sub ' column range is empty
Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(rCount)
Dim sAddress As String: sAddress = srg.Address
' Write the folder paths to an array by using the Evaluate method.
Dim Data As Variant
Data = ws.Evaluate("LEFT(" & sAddress & ",FIND(""*"",SUBSTITUTE(" _
& sAddress & ",""\"",""*"",LEN(" & sAddress & ")-LEN(SUBSTITUTE(" _
& sAddress & ",""\"",""""))))-1)")
' Write the folder paths from the array to the keys of a dictionary
' using its items to count the files.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Variant
Dim r As Long
For r = 1 To rCount
Key = Data(r, 1)
If Not IsError(Key) Then
If Len(Key) > 0 Then
dict(Key) = dict(Key) + 1
End If
End If
Next r
rCount = dict.Count
If rCount = 0 Then Exit Sub ' only blanks and error values
' Resize the array according to the number of key-value pairs
' of the dictionary and write the data from the dictionary to the array.
ReDim Data(1 To rCount, 1 To 2)
r = 0
For Each Key In dict.Keys
r = r + 1: Data(r, 1) = Key: Data(r, 2) = dict(Key)
Next Key
' Write the data from the array to the destination two-column range
' and clear the contents below.
With srg.EntireRow.Columns(dCol).Resize(, 2)
.Resize(rCount).Value = Data
.Resize(ws.Rows.Count - .Row - rCount + 1).Offset(rCount).ClearContents
End With
End Sub
我想统计 Excel VBA 文件夹中的文件数。
现在速度对我来说非常重要，所以首先我将所有文件（从文件夹和子文件夹）列出到“A”列，我想遍历所有行并计算文件夹中有多少文件。
我的“A”列列表：
D:\Steam\libraryfolder.vdf
D:\Steam\steam.dll
D:\Steam\config\appconfig.json
D:\Steam\config\chaperone_info.vrchap
D:\Steam\config\steamvr.vrsettings
D:\Steam\config\lighthouse\lighthousedb.json
D:\Steam\config\lighthouse\lhr-eebe0f79\config.json
D:\Steam\config\lighthouse\lhr-eebe0f79\userdata\Green_46GA163X002581_mura_analyzes.mc
D:\Steam\config\lighthouse\lhr-eebe0f79\userdata\Green_46HA163P000228_mura_analyzes.mc
我想获取“B”列的文件数。 所以“B”列应该如下所示：
2
2
3
3
3
1
1
2
2
目前我有这个小代码来计算“”，但不幸的是我不知道如何计算文件。
Sub test()
Dim S As String
S = "D:\Steam\config\lighthouse\lhr-eebe0f79\config.json"
MsgBox "count = " & UBound(Split(S, "\"))
End Sub
为此您不需要 VBA，标准 Excel 函数可以计算这些计数。
B 列用于从路径中提取文件名：
=MID(A1,FIND("*",SUBSTITUTE(A1,"\","*",LEN(A1)-LEN(SUBSTITUTE(A1,"\",""))))+1,LEN(A1))
然后使用C列提取路径：
=LEFT(A1,LEN(A1)-LEN(B1))
最后，D列可以统计同一目录下的文件数：
=COUNTIF(C:C,$C1)
如果您确实需要在 VBA 中执行此操作，那么这里有几个函数可以在给定完整路径的情况下提取文件名或目录：
' Returns the file name given a full file path
Function BaseName(FilePath)
BaseName = Mid(FilePath, InStrRev(FilePath, "\") + 1)
End Function
' Returns the directory path given a full file path
Function DirName(FilePath)
DirName = Mid(FilePath, 1, Len(FilePath) - Len(BaseName(FilePath)))
End Function
从文件路径列表中计算文件夹中的文件数
- 给定的文件路径列表在
A2:A20. 中
- 第一个过程的结果
CountFilesPerFolder在B2:B20中。 - 第二个过程的结果
ListFilesCountPerFolder在E2:F8中。
获取文件夹路径的Excel公式(Evaluate)
=LEFT(A2,FIND("*",SUBSTITUTE(A2,"\","*",LEN(A2)-LEN(SUBSTITUTE(A2,"\",""))))-1)
代码
Option Explicit
Sub CountFilesPerFolder()
' Source
Const sCol As String = "A"
' Destination
Const dCol As String = "B"
' Both
Const fRow As Long = 2
' Reference the worksheet.
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
' Reference the one-column range containing the file paths by using
' the End property to calculate the last row.
Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
Dim rCount As Long: rCount = slRow - fRow + 1
If rCount < 1 Then Exit Sub ' column range is empty
Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(rCount)
Dim sAddress As String: sAddress = srg.Address
' Write the folder paths to an array by using the Evaluate method.
Dim Data As Variant
Data = ws.Evaluate("LEFT(" & sAddress & ",FIND(""*"",SUBSTITUTE(" _
& sAddress & ",""\"",""*"",LEN(" & sAddress & ")-LEN(SUBSTITUTE(" _
& sAddress & ",""\"",""""))))-1)")
' Write the folder paths from the array to the keys of a dictionary
' using its items to count the files.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Variant
Dim r As Long
For r = 1 To rCount
Key = Data(r, 1)
If Not IsError(Key) Then
If Len(Key) > 0 Then
dict(Key) = dict(Key) + 1
End If
End If
Next r
If dict.Count = 0 Then Exit Sub ' only blanks and error values
' Write the files count from the items of the dictionary
' to the array (overwriting the folder paths).
For r = 1 To rCount
Key = Data(r, 1)
If dict.Exists(Key) Then
Data(r, 1) = dict(Key)
Else
Data(r, 1) = Empty
End If
Next r
' Write the files count from the array to the destination one-column range
' and clear the contents below.
With srg.EntireRow.Columns(dCol)
.Resize(rCount).Value = Data
.Resize(ws.Rows.Count - .Row - rCount + 1).Offset(rCount).ClearContents
End With
End Sub
Sub ListFilesCountPerFolder()
' Source
Const sCol As String = "A"
' Destination
Const dCol As String = "E"
' Both
Const fRow As Long = 2
' Reference the worksheet.
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
' Reference the one-column range containing the file paths by using
' the End property to calculate the last row.
Dim slRow As Long: slRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
Dim rCount As Long: rCount = slRow - fRow + 1
If rCount < 1 Then Exit Sub ' column range is empty
Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(rCount)
Dim sAddress As String: sAddress = srg.Address
' Write the folder paths to an array by using the Evaluate method.
Dim Data As Variant
Data = ws.Evaluate("LEFT(" & sAddress & ",FIND(""*"",SUBSTITUTE(" _
& sAddress & ",""\"",""*"",LEN(" & sAddress & ")-LEN(SUBSTITUTE(" _
& sAddress & ",""\"",""""))))-1)")
' Write the folder paths from the array to the keys of a dictionary
' using its items to count the files.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Variant
Dim r As Long
For r = 1 To rCount
Key = Data(r, 1)
If Not IsError(Key) Then
If Len(Key) > 0 Then
dict(Key) = dict(Key) + 1
End If
End If
Next r
rCount = dict.Count
If rCount = 0 Then Exit Sub ' only blanks and error values
' Resize the array according to the number of key-value pairs
' of the dictionary and write the data from the dictionary to the array.
ReDim Data(1 To rCount, 1 To 2)
r = 0
For Each Key In dict.Keys
r = r + 1: Data(r, 1) = Key: Data(r, 2) = dict(Key)
Next Key
' Write the data from the array to the destination two-column range
' and clear the contents below.
With srg.EntireRow.Columns(dCol).Resize(, 2)
.Resize(rCount).Value = Data
.Resize(ws.Rows.Count - .Row - rCount + 1).Offset(rCount).ClearContents
End With
End Sub