利用Excel VBA 提取指定文件夹下指定格式的文件(父子转换

2020-04-03  本文已影响0人  麦睿蔻

一个文件夹下有不定数量的子文件夹及jpg、xlsm、xls等文件,同时各子文件夹下也有数量不定的各种文件,使用VBA的父子转换法可以提取指定文件夹下的指定格式的文件,亲测运行速度是递归法的5倍以上,本例提取xls和xlsm文件,具体代码如下:

Sub 父子转换法提取指定文件夹下的文件()
  Dim fd As Object
  Dim myPath As String
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
  With fd
        If .Show = -1 Then myPath = .SelectedItems(1) Else Exit Sub
  End With
  Dim 父亲(1 To 1000) As String
  Dim f, i, k, f2, f3, x
  Dim arr1(1 To 10000, 1 To 1) As String, q As Integer
  Dim t
  t = Timer
  父亲(1) = myPath & "\"
  i = 1: k = 1
  Do While i < UBound(父亲)
    If 父亲(i) = "" Then Exit Do
    f = Dir(父亲(i), vbDirectory)
    Do
      If InStr(f, ".") = 0 And f <> "" Then
        k = k + 1
        父亲(k) = 父亲(i) & f & "\"
      End If
      f = Dir
    Loop Until f = ""
    i = i + 1
  Loop
  '*******下面是提取各个文件夹的文件***
  For x = 1 To UBound(父亲)
      If 父亲(x) = "" Then Exit For
       f3 = Dir(父亲(x) & "*.xls*")
     Do While f3 <> ""
       q = q + 1
       arr1(q, 1) = 父亲(x) & f3
       f3 = Dir
     Loop
  Next x
  ActiveSheet.UsedRange = ""
  Range("a1").Resize(q) = arr1
  Debug.Print Format(Timer - t, "0.00000")
End Sub

接下来,可以使用Name...As命令对文件进行移动、重命名等工作。

上一篇下一篇

猜你喜欢

热点阅读