Как я могу переназначить параметр .Path для объектов в моем коде? - PullRequest
0 голосов
/ 15 января 2019

У меня есть код, который просматривает папки в каталоге для конкретных файлов Excel на основе метаданных этого файла. Из-за количества папок и файлов в каталоге код выполняется долго до завершения. Я добавил клавишу отмены, чтобы я мог отменить макрос. Код также записывает последний путь, над которым он работал, в лист 1 рабочей книги.

То, что я хочу сделать, - это проверить код, есть ли какое-либо значение на листе 1, где у меня сохранен путь, и обновить путь к подпапке, чтобы, если я отменил макрос, я мог позже вернуться и запустить где я остановился. Однако, когда я пытаюсь переназначить параметр .Path, я получаю ошибку «Переменная объекта или переменная блока не установлена», поэтому я предполагаю, что это невозможно сделать таким образом.

Мой код ниже:

Path = "C:\Users\blahblah\"
destination = "C:\Users\blahblah\blibbityblah\"
Set FSO = CreateObject("Scripting.filesystemobject")
Set obj_folder = FSO.GetFolder(Path)

On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler
MsgBox "This may take a long time: press ESC to cancel"
For x = 1 To 1000000
    If Not ThisWorkbook.Sheets(1).Cells(1, 1).Value = "" Then
        obj_subfolder.Path = ThisWorkbook.Sheets(1).Cells(1, 1).Value
        ThisWorkbook.Sheets(1).Cells(1, 1).ClearContents
    End If
    For Each obj_subfolder In obj_folder.SubFolders
        For Each file In obj_subfolder.FILES
            Set oDetails = GetDetails(file.Path)
            If InStr(1, oDetails("Tags"), "EDGE") Then
                Call FSO.CopyFile(file.Path, FSO.BuildPath(destination, file.Name))0
            End If
        Next file
    Next obj_subfolder
Next x

handleCancel:
    If Err = 18 Then
        MsgBox "You cancelled"
        ThisWorkbook.Sheets(1).Cells(1, 1).Value = obj_subfolder.Path
    End If
End Sub

Блок кода, который я пытаюсь реализовать, но который выдает ошибку, приведен ниже:

If Not ThisWorkbook.Sheets(1).Cells(1, 1).Value = "" Then
    obj_subfolder.Path = ThisWorkbook.Sheets(1).Cells(1, 1).Value
    ThisWorkbook.Sheets(1).Cells(1, 1).ClearContents
End If

Если на листе есть значение в A1, я хочу изменить путь к этой подпапке, чтобы отразить то, что находится в A1, только один раз. Но я хочу, чтобы он оставался в цикле, чтобы код не пытался вернуться назад и просмотреть папки, через которые я уже прошел.

1 Ответ

0 голосов
/ 15 января 2019

Нельзя присвоить значение свойству Path класса Folder.

Подпапки возвращаются в алфавитном порядке, насколько я вижу. Таким образом, при наличии сохраненного имени папки вы можете пропустить имена папок, пока не найдете сохраненное, как показано ниже.

Option Explicit

Public Sub DoTheSubfolderThing()
    Dim Path As String
    Dim Destination As String
    Dim FSO As Object
    Dim obj_folder As Object
    Dim obj_subfolder As Object
    Dim file As Object
    Dim cancelPath As String
    Dim proceed As Boolean
    Dim x As Long

    Path = "C:\Users\blahblah\"
    Destination = "C:\Users\blahblah\blibbityblah\"
    Set FSO = CreateObject("Scripting.filesystemobject")
    Set obj_folder = FSO.GetFolder(Path)

    On Error GoTo handleCancel

    Application.EnableCancelKey = xlErrorHandler
    MsgBox "This may take a long time: press ESC to cancel"

    cancelPath = CStr(ThisWorkbook.Sheets(1).Cells(1, 1).Value)
    proceed = (Len(cancelPath) = 0)

    For x = 1 To 1000000
        For Each obj_subfolder In obj_folder.SubFolders
            If Not proceed Then
                'Only proceed once we hit the saved folder name.
                proceed = (StrComp(obj_subfolder.Path, cancelPath, vbTextCompare) = 0)
            End If

            If proceed Then
                For Each file In obj_subfolder.Files
                    'Your code...
                    'Set oDetails = GetDetails(file.Path)
                    'If InStr(1, oDetails("Tags"), "EDGE") Then
                    '    Call FSO.CopyFile(file.Path, FSO.BuildPath(Destination, file.Name))
                    'End If
                Next file

                ThisWorkbook.Sheets(1).Cells(1, 1).ClearContents
            End If
        Next obj_subfolder
    Next x

handleCancel:
        If Err = 18 Then
            MsgBox "You cancelled"
            ThisWorkbook.Sheets(1).Cells(1, 1).Value = obj_subfolder.Path
        End If
End Sub

Предполагается, что ваш внешний цикл For предназначен только для иллюстративных целей. Мой пример кода очищает сохраненный путь в точке, которая заставит внутренние циклы сканировать все файлы после первой итерации по x, что может не соответствовать тому, что вы пытаетесь выполнить.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...