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

Question

我有一些代码，可以根据文件的元数据在目录中的文件夹中查找特定的excel文件。由于目录中文件夹和文件的数量，代码在完成之前会运行很长时间。我添加了一个取消键，这样我就可以取消宏了。该代码还将其处理的最后一个路径写入工作簿的工作表1。

我想做的是让代码检查工作表1中保存路径的位置是否有任何值，并更新子文件夹路径，这样，如果我取消宏，我以后可以返回并从停止的位置开始。但是，当我尝试重新分配.path参数时，我会得到一个"Object variable or with block variable not set"错误，所以我认为不能这样做。

我的代码如下：

Path = "C:Usersblahblah"
destination = "C:Usersblahblahblibbityblah"
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中的内容一次。但我希望它保持在循环中，这样代码就不会试图返回并浏览我已经浏览过的文件夹。

Answer 1

不能为Folder类的Path属性赋值。

据我所见，子文件夹是按字母顺序返回的。因此，如果存在已保存的文件夹名称，您可以跳过文件夹名称，直到找到已保存的名称，如下所示。

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:Usersblahblah"
Destination = "C:Usersblahblahblibbityblah"
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上的第一次迭代后扫描所有文件，这可能不是您想要实现的。