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

 

posted on 2019-04-09 14:31  若阳y  阅读(45)  评论(0)    收藏  举报

导航