如何在代码中为对象重新分配.Path参数?

时间:2019-01-14 21:16:34

标签: excel vba

我有一些代码可根据该文件的元数据在目录中的文件夹中查找特定的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 :(得分:0)

您不能为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上进行第一次迭代后扫描所有文件,这可能不是您要完成的工作。