Question

我有一些代码从单元格接收文件路径并读取目录中的文件夹列表。我希望它在两个单元格的循环中执行此操作（在我的情况下为B8和B9）。目前代码正在查看第一个文件路径两次，而不是两个路径一次。我认为代码部分导致我的问题在于：

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＆amp;后来9如预期，但MsgBox objFolder仍停留在B8.value。我觉得我需要通过将objFolder设置为null或类似来清除objFolder但是尝试了一些变体而没有成功。

更新以提供更多代码，以防我无意中做了一些我不应该做的事情：

整个内容读入文件路径，在路径中找到特定的文本文件，解压缩然后将文本文件导入两个选项卡。

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

Answer 1

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

@Kyle已经确定了导致此问题的可能原因，即使用On Error Resume Next进行不正确的错误处理会导致指定文件夹路径无法存在。

On Error Resume Next是Devil的工作，除非您知道如何在本地使用它并捕获错误。通常最好预测这些异常的错误和代码，如下所示，我们使用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

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

1 个答案: