VBA获取某文件夹下所有文件和子文件目录的文件

【引用位置】 https://blog.csdn.net/pashine/article/details/42100237

'-------------------------------------------

'获取某文件夹下的所有Excel文件

'-------------------------------------------

Sub getExcelFile(sFolderPath As String)

On Error Resume Next

Dim f As String

Dim file() As String

Dim x

k = 1

ReDim file(1)

file(1) = sFolderPath &""

End Sub

'-------------------------------------------

'获取某文件夹下的所有文件和子扰者好目录下的文件

'-------------------------------------------

Sub getAllFile(sFolderPath As String)

'Columns(1).Delete

On Error Resume Next

Dim f As String

Dim file() As String

Dim i, k, x

x = 1

i = 1

k = 1

ReDim file(1 To i)

file(1) = sFolderPath &""

'-- 获得所有子目录

Do Until i >k

f = Dir(file(i), vbDirectory)

Do Until f = ""

If InStr(f, ".") = 0 Then

k = k + 1

ReDim Preserve file(1 To k)

file(k) = file(i) &f &""

End If

f = Dir

Loop

i = i + 1

Loop

'-- 获得所有子目录下的所有文件

For i = 1 To k

f = Dir(file(i) &" . ")'通嫌塌配符 . 表示所有文件，*.xlsx Excel文件

Do Until f = ""

'Range("a" &x) = f

Range("a" &x).Hyperlinks.Add Anchor:=Range("缓铅a" &x), Address:=file(i) &f, TextToDisplay:=f

x = x + 1

f = Dir

Loop

Next

End Sub

Public Sub 遍态袭历()

Dim arr, brr

Application.ScreenUpdating = False

Application.DisplayAlerts = False

t = Timer

mypath = ThisWorkbook.Path &"\"

myname = Dir(mypath &"*.xls*")

ReDim brr(1 To 1000000, 1 To 6)

n = 1

Do While myname <>""

If myname <>ThisWorkbook.Name Then

Workbooks.Open (mypath &myname)

arr = ActiveSheet.Range("a1").CurrentRegion.Value

ActiveWorkbook.Close

For i = 1 To UBound(arr)

If arr(i, 5) = "签收" Or arr(i, 5) = "驿站代收羡闭肆" Or arr(i, 5) = "柜机代收兄轿" Then

For j = 1 To 6

brr(n, j) = arr(i, j)

Next

n = n + 1

End If

Next

End If

myname = Dir

Loop

ThisWorkbook.Sheets(1).[a1].Resize(1, 6) = arr

ThisWorkbook.Sheets(1).[a2].Resize(UBound(brr), 6) = brr

Columns(1).Select

Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _

:=Array(1, 2), TrailingMinusNumbers:=True

MsgBox Timer - t

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

新建一个xlsm文件，复制如下代码到这个文件尘裤中，F5执行代码

就可d出工作表数量（注意工作簿默认是xlsx格键烂式）

Sub 鱼稿兄漏木混猪()

Application.ScreenUpdating = False

f = Dir(ThisWorkbook.Path &"\*.xlsx")

Do While f <>""

Workbooks.Open ThisWorkbook.Path &"\" &f

数量 = 数量 + ActiveWorkbook.Sheets.Count

ActiveWorkbook.Close

f = Dir

Loop

Application.ScreenUpdating = True

MsgBox 数量

End Sub

---