|
最近因为工作的原因有很长时间没有发文了，但是繁琐的工作还是在继续，前几天碰见一个工作上的小问题，就是需要在不同的文件下创建特定的2个文件夹，就是说某个目录下的文件夹需要里面都创建2个文件夹，例如：1_勘查照片,2_勘查资料，麻烦的是文件夹很多，如果一个个点开每个文件夹，然后点新建文件夹改名字，很是繁琐，累人，当时的情况是任务比较紧，我就真的一个个点开创建文件，哎，不对，写到这我突然想起创建好了2个特定文件夹可以把他们复制，然后1个个点开文件夹在复制进去，可能这样稍微好点，我应该当时是弄的后者，老了，记性不太好了，不过还是又必须要研究一下用VBA批量创建特定的文件夹。 我们来看一个例子，桌面上有个“示例”文件夹，文件下下面有150个文件夹，截图如下： 需要在这150个文件下新建2个文件夹：1_勘查照片,2_勘查资料,这个工作怎么“破”，大概的思路还是像以前写的，需要循环获取每个文件夹，然后进去该文件夹下去创建2个文件夹，以前都是用dir来获取文件，那怎么获取每个文件夹哪？查了一下资料,然后自己修改了一下，下面我们来看下怎么实现这个功能，我们在这个目录下新建'示例.xlsm'工作薄，把代码放进VBE里面的模块，代码如下： Sub CreateFoder() Dim Mypath As String Dim Myfile As String Mypath = 'C:\Users\Administrator\Desktop\示例\' '指定路径 Myfile = Dir(Mypath, vbDirectory) '获取目录 Do While Myfile <> '' '开始循环 If Myfile <> '.' And Myfile <> '..' Then '跳过当前目录及上层目录 If (GetAttr(Mypath & Myfile) And vbDirectory) = vbDirectory Then On Error Resume Next VBA.MkDir (Mypath & Myfile & '\' & '1_勘查照片') '在相应的目录下创建子文件夹 VBA.MkDir (Mypath & Myfile & '\' & '2_勘查资料') End If End If Myfile = Dir Loop End Sub 上面的MKDir 函数就是创建一个目录，GetAttr函数是获取文件的属性，dir函数用参数vbdirectory 会返回当前目录'.'，用1个点表示，还会返回上层目录'..'，用2个点表示，咱们要忽略掉这2个返回值，就用了一个if语句加以判断，然后就判断获取文件的属性，如果是目录，就进入相应的文件夹创建文件夹。大概就是这个意思。上面的程序运行一下，就可以在各个文件夹下面创建2个文件夹：1_勘查照片,2_勘查资料，效果如下： |
|
|
