цикл по подпапкам и их подпапкам - PullRequest
Новая
       8

цикл по подпапкам и их подпапкам

0 голосов
/ 28 декабря 2018

Я новичок в программировании и собрал воедино этот скрипт, который отлично работает на первом уровне подпапок.Я хочу, чтобы он вошел в подпапки, их подпапки и их подпапки, и я также не должен был устанавливать подстановочный знак, поэтому он копирует файл только в том случае, если имя имеет « budgetts ».Любая помощь с благодарностью 

Sub Copy_files_this_works()
Dim FSO As Object, fld As Object
Dim fsoFile As Object
Dim fsoFol As Object

    FromPath = "S:\SERVICE CHARGES 2018\" 
    ToPath = "S:\SERVICE CHARGES 2018\Budget Upload\"  

Set FSO = CreateObject("Scripting.FileSystemObject")
Set fld = FSO.GetFolder(FromPath)

If FSO.FolderExists(fld) Then
    For Each fsoFol In FSO.GetFolder(FromPath).SubFolders
        For Each fsoFile In fsoFol.Files
            If Right(fsoFile, 4) = "xlsx" Then
                fsoFile.Copy ToPath
            End If
        Next
    Next
End If

End Sub

1 Ответ

0 голосов
/ 28 декабря 2018

Изменение:

  1. HostFolder - Путь, который вы хотите зациклить.
  2. Убедитесь, что существует Sheet1 - Место, куда будут экспортироваться детали.
  3. Вставьте две подпрограммы и запустите "Main_Process"

Попробуйте: 

Option Explicit

Sub Main_Process()

    Dim FileSystem As Object
    Dim HostFolder As String
    Dim LRC As Long

    HostFolder = "C:\Users\XXXX\Desktop\Test\"

    With ThisWorkbook.Worksheets("Sheet1")

        LRC = .Cells(.Rows.Count, "A").End(xlUp).Row

        .Range("A2:F" & LRC).Clear

    End With

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder FileSystem.getFolder(HostFolder)

End Sub

Sub DoFolder(Folder)

    Dim SubFolder
    Dim File
    Dim LR As Long

    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next

    For Each File In Folder.Files

        With ThisWorkbook.Worksheets("Sheet1")

            LR = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Cells(LR + 1, 1).Value = File.Name
            .Cells(LR + 1, 2).Value = File.DateCreated
            .Cells(LR + 1, 3).Value = File.DateLastAccessed
            .Cells(LR + 1, 4).Value = File.DateLastModified
            .Cells(LR + 1, 5).Value = File.Type
            .Cells(LR + 1, 6).Value = File.Path

            .Cells(1, 1).Value = "Date"
            .Cells(1, 2).Value = Date

        End With

    Next

    ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns.AutoFit

End Sub
...