时间戳

首页 > 解决方案 > 从路径的一部分是变量 VBA 的子文件夹中处理文件

excel - 从路径的一部分是变量 VBA 的子文件夹中处理文件

问题描述

我有宏从文件夹“Nord”和那里的所有子文件夹中复制文件。现在我只需要从 Nord 文件夹中名为“2020”的一个子文件夹中复制文件。所以复制文件的路径是“U:\user\Documents\Nord*\2020”，其中 * 是变量，代表我需要复制其数据的人名。但在每个人的文件夹中，子目录很少，我只需要 2020 年的数据。

它应该只复制尚未复制的文件，这就是我在 Masterwb 中引用 files_list 的原因。

你能帮我修改这段代码吗？我应该在某处添加 if 子句吗？谢谢

Sub loopAllSubFolderSelectStartDirectory()

Dim FSOLibrary As FileSystemObject
Dim FSOFolder As Object
Dim folderName As String
Dim Filename As String


'Set the folder name to a variable
folderName = "U:\user\Documents\Nord"

'Set the reference to the FSO Library
Set FSOLibrary = New FileSystemObject

LoopAllSubFolders FSOLibrary.GetFolder(folderName)

End Sub

Sub LoopAllSubFolders(FSOFolder As Object)

Dim FSOSubFolder As Object
Dim fsoFile As Object
Dim Masterwb  As Workbook
Dim NewSht As Worksheet
Dim LastRow As Long
Dim i As Integer
Dim Filename As String


targetpath = "C:\Users\Destination\nord\"
Set Masterwb = Workbooks("Raw_data_2020.xlsm")
Set NewSht = Masterwb.Worksheets("files_list")
LastRow = NewSht.Range("A" & Rows.Count).End(xlUp).Row

For Each FSOFolder In FSOFolder.subfolders

    For Each fsoFile In FSOFolder.Files

        Filename = Dir(fsoFile)
            If Right(fsoFile, 4) = "xlsm" Then
                found = False
                For i = 1 To LastRow
                    If Filename = Cells(i, 1).Value Then
                        found = True
                           
                    End If
                Next i
                If Not found Then fsoFile.Copy targetpath

                Filename = Dir
            End If
Next
Next

End Sub

标签： excelvba

解决方案

请测试下一个代码：

Sub copyFromAllSubFoldSpecificNameCheck()
 Dim FSOLibrary As New FileSystemObject, FSONord As Scripting.Folder
 Dim FSOSubfld1 As Scripting.Folder, FSOSubfld2 As Scripting.Folder

 Dim foldNord As String, fldSearch As String, fsoFile As Scripting.File
 Dim NewSht As Worksheet, lastRow As Long, arrFil, i As Long, boolFound As Boolean
 Dim targetPath As String

 foldNord = "C:\Users\Destination\nord\"
 targetPath = "C:\Users\Destination\nord\"
 fldSearch = "2020" 'the subfolder name to be searched for
 Set NewSht = Workbooks("Raw_data_2020.xlsm").Worksheets("files_list")
 lastRow = NewSht.Range("A" & rows.count).End(xlUp).row
 arrFil = NewSht.Range("A1:A" & lastRow).value 'put it in an array to run faster
 
 Set FSONord = FSOLibrary.GetFolder(foldNord)
 For Each FSOSubfld1 In FSONord.SubFolders
    For Each FSOSubfld2 In FSOSubfld1.SubFolders
        If FSOSubfld2.name = fldSearch Then
            For Each fsoFile In FSOSubfld2.Files
                If Right(fsoFile.name, 4) = "xlsm" Then
                    boolFound = False
                    For i = 1 To UBound(arrFil)
                       If fsoFile.name = arrFil(i, 1) Then
                            boolFound = True: Exit For 'exiting to be faster
                       End If
                    Next i
                    If (Not boolFound) And (Not FSOLibrary.FileExists(targetPath & fsoFile.name)) Then
                        fsoFile.Copy targetPath
                    End If                    
                End If
            Next
            Exit for
        End If
    Next
 Next
End Sub

最后一个没有测试（我没有时间建立测试表）......

请测试我提供的代码并发送一些反馈。

推荐阅读