VBA-DIR函数（文件自动归档）

最新推荐文章于 2024-07-16 14:53:02 发布

OYQ697

最新推荐文章于 2024-07-16 14:53:02 发布

阅读量1.7k

点赞数 2

分类专栏： VBA 文章标签：其他

本文链接：https://blog.csdn.net/qq_41777527/article/details/106024543

版权

VBA 专栏收录该内容

31 篇文章 25 订阅

订阅专栏

1.今天用dir函数做了一个自动将文件归档的程序，我们一起来看看效果，首先，文件夹里面的文件名称如下图所示，我们可以看到所有的文件名（除我们写VBA代码的表格）都符合2020.xx.xx.xlsx的格式

2.我们要做的是将同一月份的表格放到一个文件夹里，当我们运行代码就会得到以下两张图的结果，所有文件都被放到对应月份的文件夹里

3.接下来，看看我们如何实现吧，具体代码如下（由于注释较详细，这里就不过多说明）

Sub autotest()
'定义变量（文件名+集合（收集文件名名称集合））
Dim fname
Dim namelist As New Collection
'根目录（按自己的实际情况来，一定要在路径的后面加“\”,方便后面操作）
rootpath = "C:\Users\OYQ_LJL\Desktop\OYQ\文件自动归档\"
'dir 指定目录下第一个文件
fname = Dir(rootpath, vbDirectory)

Do While fname <> ""
'遍历该路径下所有文件，将文件名获取到namelist集合中
    If fname <> "." And fname <> ".." Then
    namelist.Add fname
    End If
'dir 指向下一个文件
fname = Dir
Loop
'定义数组，可以是字符串
Dim arr
arr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
Dim i As Long, j As Integer
'遍历每一个item
For i = 1 To namelist.Count
    For j = 0 To UBound(arr)
'当文件名符合XXXX.XX.XX的格式，就会对应的将其移动到其分类的文件夹里
        If Val(Mid(namelist(i), 6, 2)) = arr(j) Then
'当该目录下没有对应的分类文件夹，自动创建一个文件夹
            If Dir(rootpath & Val(Mid(namelist(i), 6, 2)) & "月", vbDirectory) = "" Then
               MkDir (rootpath & Val(Mid(namelist(i), 6, 2)) & "月")
            End If
'移动对应的文件到对应的文件夹里
        FileCopy rootpath & namelist.Item(i), rootpath & Val(Mid(namelist(i), 6, 2)) & "月/" & namelist.Item(i)
        Kill rootpath & namelist.Item(i)
        Exit For
        End If
    Next j
Next i
End Sub