Dir()函数获取路径下文件名
注: 使用dir()函数时,
Sub a() Application.DisplayAlerts = False Dim l As String l = Dir("C:\Users\wanglong\Desktop\新建文件夹\" & "*.xls") '此处会将所有的xls,xlsm,xlsx等文件均打开,只有当是xlsm or xlsx则只打开xlsm or xlsx相应文件 Do While l <> "" Workbooks.Open Filename:="C:\Users\wanglong\Desktop\新建文件夹\" & l l = Dir Loop Application.DisplayAlerts = True End Sub
注:此种情况会将所有的xls,xlsm,xlsx等文件均打开,只有当是xlsm or xlsx则只打开xlsm or xlsx相应文件。



例:
将多个工作簿中的数据合并到同一张工作表中
Sub a() Dim bt As Range, r As Long, c As Long r = 1 c = 7 Dim wt As Worksheet Set wt = ThisWorkbook.Worksheets(1) wt.Rows(r + 1 & ":1048576").ClearContents Application.ScreenUpdating = False Dim filename As String, sht As Worksheet, wb As Workbook Dim erow As Long, fn As String, arr As Variant filename = Dir(ThisWorkbook.Path & "\*.xlsx") '注:这里dir函数获取的文件名是包括.xlsx后缀的 Do While filename <> "" If filename <> ThisWorkbook.Name Then erow = wt.Range("A1").CurrentRegion.Rows.Count + 1 fn = ThisWorkbook.Path & "\" & filename Set wb = GetObject(fn) Set sht = wb.Worksheets(1) arr = sht.Range(sht.Cells(r + 1, "A"), sht.Cells(1048576, "B").End(xlUp).Offset(0, 5)) wt.Cells(erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr wb.Close False End If filename = Dir '重新调取Dir函数,不使用参数,返回其他文件名,若返回文件名为空时,需重新使用参数,否则报错 Loop Application.ScreenUpdating = True End Sub

浙公网安备 33010602011771号