VBA:在for循环中设置一个对象,对象卡在第一个值上

我有一些代码从一个单元格获取文件path并读取目录中的文件夹列表。 我想要它在一个循环中做两个单元格(在我的情况下B8和B9)。 目前代码正在查看第一个文件path两次,而不是两个path一次。 代码中的部分我认为是造成我的问题在这里:

Dim objFSO As Object Dim objFolder As Object For k = 8 to 9 Set objFSO = CreateObject("Scripting.FileSystemObject") MsgBox k Set objFolder = objFSO.GetFolder(Range("B" & k).Value) MsgBox objFolder 'do the bit of code that reads the files Next 

第一个消息框按预期方式返回8或更高版本9,但MsgBox objFolder停留在B8.value上。 我觉得我需要通过将objFolder设置为null或类似来清除objFolder,但是尝试了一些这种变化,但没有成功。

更新提供更多的代码,以防万一我不知不觉地做了一些我不应该做的事情:

整个事情读取文件path,在path中find一个特定的文本文件,解压缩,然后将文本文件导入到两个选项卡。

 Sub Example1() Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim i As Integer Dim Directory(15) As String Dim ZIPFile As Variant Set objFSO = CreateObject("Scripting.FileSystemObject") 'moved to outside now For k = 8 To 9 Set objFolder = objFSO.GetFolder(Range("B" & k).Value) i = 0 For Each objFile In objFolder.Files Directory(i) = objFile.Path i = i + 1 Next objFile For i = 0 To 14 If Right(Directory(i), 6) = "FQ.zip" Then ZIPFile = Directory(i) Next Dim FSO As Object Dim oApp As Object Dim Fname As Variant Dim FileNameFolder As Variant Dim DefPath As String Dim strDate As String DefPath = "Path name..." 'Create the folder name strDate = Format(Now, " dd-mm-yy h-mm-ss") FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\" MkDir FileNameFolder Set oApp = CreateObject("Shell.Application") oApp.Namespace(Fname).items Sheets(1).Range("F" & k).Value = Replace(Right(ZIPFile, 25), ".zip", "") & "\EL-contract-rg.txt" oApp.Namespace(FileNameFolder).CopyHere _ oApp.Namespace(ZIPFile).items.Item(Replace(Right(ZIPFile, 26), ".zip", "") & "\EL-contract-rg.txt") MsgBox "You find the files here: " & FileNameFolder On Error Resume Next Set FSO = CreateObject("scripting.filesystemobject") FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True Sheets(k - 6).Select With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & FileNameFolder & "EL-contract-rg.txt", Destination:=Range("$A$1") _ ) .Name = "Sample" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Next End Sub 

这可以按预期工作,顺便说一句,您的代码也按预期工作,不会出现您在OP中描述的问题。

@Kyle已经确定了这个问题的一个可能的原因,这将是不正确的error handling与On Error Resume Next一个将展现指定的文件夹path的故障不存在。

On Error Resume Next是魔鬼的工作,除非你知道如何在本地使用它并捕获错误。 通常最好是预测这些exception的错误和代码,如下所示,我们使用FSO类的.FolderExists方法来处理那些本来是运行时错误的东西:

 Sub foo() Dim objFSO As Object Dim objFolder As Object Set objFSO = CreateObject("Scripting.FileSystemObject") For k = 8 To 9 If objFSO.FolderExists(Range("B" & k).Value) Then Set objFolder = objFSO.GetFolder(Range("B" & k).Value) Debug.Print k & vbTab & objFolder End If Next End Sub 

在这里输入图像说明