遍历所有文件夹及其所有子文件夹VBA [英] Loop Through All Folders and All its Subfolders VBA

问题描述

我知道这个问题之前曾被问过很多次，我已经检查了先前的建议，但是我无法使我的代码运行.

i know the question was asked many times before, i have checked the previous suggestions but i couldn't make my code run.

因此，我有一个名为"Report"的文件夹，其中也包含多个文件夹.这些文件夹包含.xlsx和.zip文件.

So, i have a folder called "Report" which contains multiple folders as well. These folders contains .xlsx and .zip files.

每个文件还包含一个名为"2016"的文件夹，并在其下有12个文件夹"January"，"February"，...，"December".

Each file contains also a folder called "2016" and under it 12 folders "January", "February",..., "December".

这里是一个子文件夹的示例

Here is an example of one Subfolder

我想要做的是，遍历所有这些子文件夹，然后将基于.createdDate的.xlsx和.zip文件移动到每月文件夹中.

What i want to do is, to loop through all these subFolders and move the .xlsx and .zip files to the monthly folder based on createdDate.

例如，在11月创建的位置中的所有.xlsx和.zip都将移至同一位置的"2016"中的文件夹"November".

For example, all .xlsx and .zip in a location created in November they will be moved to the folder "November" in "2016" in the same location.

我创建了这个宏，但它很耗时，因为每次我需要更改每个子文件夹的路径并为每个子文件夹运行它时.

I created this macro but it's time consuming because everytime i need to change the path of each subfloder and run it for each subFolder.

Sub Move_Files_To_Folder()

Dim Fso As Object
Dim FromPath As String
Dim ToPath As String
Dim FileInFromFolder As Object

'Change Path
FromPath = "C:\Report\Shipment\"
ToPath = "C:\Report\Shipment\2016\"

Set Fso = CreateObject("scripting.filesystemobject")

For Each FileInFromFolder In Fso.GetFolder(FromPath).Files

'Change month and year
If (Month(FileInFromFolder.DateCreated)) = 11 And (year(FileInFromFolder.DateCreated)) = 2016 _
And (InStr(1, FileInFromFolder.name, ".xlsx") Or InStr(1, FileInFromFolder.name, ".zip")) Then
FileInFromFolder.Move (ToPath & MonthName(Month(FileInFromFolder.DateCreated)) & "\")
End If

Next FileInFromFolder

End Sub

我想使我的宏自动化，以便它可以在所有子文件夹上运行，而不是一个接一个地更改路径.有什么建议吗?非常感谢你.

I want to automate my macro so that it will work on all the subfolders Not one by one and changing the path everytime. Any suggestions please ? Thank you very much.

推荐答案

与@luke_t和@Lowpar不同，我不认为递归循环在所有子文件夹和文件中查找都是正确的答案，因为当您进入底部文件夹(即 C:\ Report \ Shipment \ 2016 \ May \ )，您将获取并移动已放置在正确位置的文件.

Unlike @luke_t and @Lowpar, I don't think that recursive loop, looking in all subfolders and files is right answer here, because when you get to the bottom folder (i.e. C:\Report\Shipment\2016\May\) you will get and move files that are already in right place.

由于文件夹具有固定的结构，因此您可以遍历主文件夹的每个子文件夹中的每个 .xlsx 和 .zip 文件(C:\ Report \ ).

Thanks to fact that you have fixed structure of folders, you can just loop through every .xlsx and .zip file in every subfolder of main folder (C:\Report\).

Sub Move_Files_To_Folder()

Dim Fso As Object, objFolder As Object, objSubFolder As Object
Dim FromPath As String
Dim FileInFolder As Object

FromPath = "C:\Report\"
Set Fso = CreateObject("Scripting.filesystemobject")
Set objFolder = Fso.GetFolder(FromPath)

For Each objSubFolder In objFolder.subfolders
    For Each FileInFolder In objSubFolder.Files

        If InStr(1, FileInFolder.Name, ".xlsx") Or InStr(1, FileInFolder.Name, ".zip") Then
            FileInFolder.Move (objSubFolder.path & "\2016\" & MonthName(Month(FileInFolder.DateCreated)) & "\")
        End If

    Next FileInFolder
Next objSubFolder

End Sub

但是，如果文件夹的结构是动态的，则建议使用@luke_t的方法更为合适.

However, if structure of folders would be dynamic, the approach that proposed @luke_t would be more appropriate.

这篇关于遍历所有文件夹及其所有子文件夹VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！