vba中要获取文件夹里excel文件的数量，要用什么语句？

1.GetAttr 函数

语法：GetAttr(pathname)

功能：获取一个文件、目录、或文件夹的属性。返回一个 Integer值。

返回值

由 GetAttr 返回的值，是下面这些属性值的总和：

常数 值描述

vbNormal0常规

vbReadOnly1只读

vbHidden2隐藏

vbSystem4 系统文件

vbDirectory16目录或文件夹

vbArchive32存档文件

vbalias64指定的文件名是别名。只在Macintosh中可用。

说明：若要判袜凳迅断告此是否设置了某个属性，在 GetAttr 函数与想要得知的属性值之间使用 And 运算符与逐位比较。如果所得的结果不为零，则表示设置了这个属性值。

示例：

Debug.Print GetAttr("F:\test.txt") '若为存档文粗手件，在立即窗口可看到值为32

Debug.Print GetAttr("F:\test.txt") '将属性—高级—可存档文件的勾去掉后，值为0

为判断一个文件是否只读，可用下法:

Debug.Print GetAttr("F:\test.txt") And vbReadOnly

若值非零，说明时只读的。

2.复制

'

' （1）.在不需要逐个打开工作簿的情况下,将其有效工作表依次复制到本工作簿的最后.

' 新工作表名为:原工作簿名_原工作表名

'

' Sub 复制工作表()

Dim MyObject As Object

Dim strPath As String, strFileName As String, strMyName As String

Dim shtSheet As Worksheet, strShtName As String

Dim intCount As Integer, intShtCount As Integer, i As Integer

Application.ScreenUpdating = False

strPath = ThisWorkbook.Path

strMyName = ThisWorkbook.Name

intShtCount = ThisWorkbook.Sheets.Count

With Application.FileSearch

.NewSearch

.LookIn = strPath

.SearchSubFolders = False

.Filename = ".xls"

.FileType = msoFileTypeOfficeFiles

If .Execute() >0 Then

intCount = .FoundFiles.Count

For i = 1 To intCount

strFileName = Replace(.FoundFiles(i), strPath &"\", "")

If strFileName <>strMyName Then

Set MyObject = GetObject(strPath &"/" &strFileName)

'下面进行复制工作

For Each shtSheet In MyObject.Worksheets

strShtName = shtSheet.Name

If MyObject.Sheets(strShtName).UsedRange.Count >1 Then

MyObject.Sheets(strShtName).Copy After:=ThisWorkbook.Sheets(intShtCount)

intShtCount = intShtCount + 1

'重新命名

strShtName = Replace(strFileName, ".xls", "_") &strShtName

ThisWorkbook.Sheets(intShtCount).Name = strShtName

ThisWorkbook.Sheets("目录").Cells(i + 1, 1) = strShtName

End If

Next shtSheet

End If

Next i

Else

MsgBox "没有找到符合指定文件，请修改参数后重新搜索！", ,"提示"

End If

End With

ThisWorkbook.Sheets("目录").Select

Application.ScreenUpdating = True

End Sub

'

'（2） 逐个打开同一目录下的所有工作簿,将其有效工作表依次复制到本工作簿的最后.复制完后关闭它.

' 新工作表名为:原工作簿名_原工作表名

'

Sub 复制工作表_2()

Dim MyObject As Object

Dim strPath As String, strFileName As String, strMyName As String

Dim shtSheet As Worksheet, strShtName As String

Dim intCount As Integer, intShtCount As Integer, i As Integer

Application.ScreenUpdating = False

strPath = ThisWorkbook.Path

strMyName = ThisWorkbook.Name

intShtCount = ThisWorkbook.Sheets.Count

With Application.FileSearch

.NewSearch

.LookIn = strPath

.SearchSubFolders = False

.Filename = ".xls"

.FileType = msoFileTypeOfficeFiles

If .Execute() >0 Then

intCount = .FoundFiles.Count

For i = 1 To intCount

strFileName = Replace(.FoundFiles(i), strPath &"\", "")

If strFileName <>strMyName Then

'Workbooks.Open Filename:=strPath &"/" &strFileName

Set MyObject = GetObject(strPath &"/" &strFileName)

'下面进行复制工作

For Each shtSheet In Workbooks(strFileName).Worksheets

strShtName = shtSheet.Name

If Workbooks(strFileName).Sheets(strShtName).UsedRange.Count >1 Then

Workbooks(strFileName).Sheets(strShtName).Copy After:=ThisWorkbook.Sheets(intShtCount)

intShtCount = intShtCount + 1

'重新命名

strShtName = Replace(strFileName, ".xls", "_") &strShtName

ThisWorkbook.Sheets(intShtCount).Name = strShtName

ThisWorkbook.Sheets("目录").Cells(i + 1, 1) = strShtName

End If

Next shtSheet

'Workbooks(strFileName).Close

End If

Next i

Else

MsgBox "没有找到符合指定文件，请修改参数后重新搜索！", ,"提示"

End If

End With

ThisWorkbook.Sheets("目录").Select

Application.ScreenUpdating = 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

---