社区首页 >问答首页 >VBA Excel:将每个结果转换成单元格？计数器不工作了吗？

问VBA Excel:将每个结果转换成单元格？计数器不工作了吗？
EN

Stack Overflow用户

提问于 2017-12-10 08:23:35

回答 1查看 60关注 0票数 0

我正在创建一个宏，它爬行到子文件夹中，并检索一些文件的名称。我使用this answer中的代码来回答另一个问题，可以很好地将结果放入“即时”窗口，但我希望将结果放入单元格，作为列表。我得到的只是第一次迭代的结果。

我想要做的可能是显而易见的，但我发誓我试过了，但我自己找不到答案。顺便说一句，我才刚刚开始编程。

我的代码在这里。最重要的部分在子ListFiles中(fld作为对象，Mask作为字符串)。

Option Explicit

Sub Retrieve_Info()

Dim strPath As Variant
Dim pasta_destino As Range
Dim fle As String
Dim fso As Object 'FileSystemObject
Dim fldStart As Object 'Folder
Dim fld As Object 'Folder
Dim fl As Object 'File
Dim Mask As String

Set pasta_destino = ThisWorkbook.Worksheets("VINCULATOR").Range("pasta_destino")
strPath = Application.GetOpenFilename _
(Title:="Selecione o arquivo.xlsx", _
FileFilter:="Excel Files *.xlsx* (*.xlsx*),")

If Not strPath = False Then
pasta_destino = strPath
fle = Dir(strPath)

Set fso = CreateObject("scripting.FileSystemObject") ' late binding
'Set fso = New FileSystemObject 'or use early binding (also replace Object types)

Set fldStart = fso.GetFolder(Replace(strPath, fle, ""))
Mask = "*.xlsx"
For Each fld In fldStart.SubFolders
ListFiles fld, Mask
Next
End If
End Sub

Sub ListFiles(fld As Object, Mask As String)
    Dim fl As Object 'File
    Dim vrow As Integer
    Dim vinculadas As Range
    Dim n_vinc As Range
    Set vinculadas = ThisWorkbook.Worksheets("VINCULATOR").Range("vinculadas")
    Set n_vinc = ThisWorkbook.Worksheets("VINCULATOR").Range("n_vinc")
    vrow = 0
    For Each fl In fld.Files
       If fl.Name Like Mask And InStr(fl.Name, "completo") = 0 Then
       vrow = vrow + 1
            vinculadas.Cells(vrow, 1) = fld.Path & "\" & fl.Name
        End If
    Next
   n_vinc = vrow
End Sub

求求你救命！

excel

loops

vba

回答 1

Stack Overflow用户

回答已采纳

发布于 2017-12-10 11:38:34

我采用了一种稍微不同的方法，除了执行速度更快之外，它可能更容易让您遵循。请试一下这个。

Sub SpecifyFolder()
    ' 10 Dec 2017

    Dim Fd As FileDialog
    Dim PathName As String
    Dim Fso As Object
    Dim Fold As Object, SubFold As Object
    Dim i As Long

    Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
    With Fd
        .ButtonName = "Select"
        .InitialView = msoFileDialogViewList
        .InitialFileName = "C:\My Documents\"       ' set as required
        .Show

        If .SelectedItems.Count Then
            PathName = .SelectedItems(1)
        Else
            Exit Sub                                ' user cancelled
        End If
    End With
    Set Fd = Nothing

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Fold = Fso.GetFolder(PathName)
    ListFiles Fold, "*.xlsx"
    For Each SubFold In Fold.SubFolders
            ListFiles SubFold, "*.xlsx"
    Next SubFold
    Set Fso = Nothing
End Sub

Sub ListFiles(Fold As Object, _
              Mask As String)
    ' 10 Dec 2017

    Dim Fun() As String                             ' file list
    Dim Rng As Range
    Dim Fn As String                                ' file name
    Dim i As Long                                   ' array index

    ReDim Fun(1 To 1000)                            ' maximum number of expected files in one folder
    Fn = Dir(Fold.Path & "\")
    Do While Len(Fn)
        If Fn Like Mask And InStr(Fn, "completo") = 0 Then
            i = i + 1
            Fun(i) = Fold.Path & "\" & Fn
        End If
        Fn = Dir
    Loop

    If i Then
        ReDim Preserve Fun(1 To i)
        With ThisWorkbook.Worksheets("VINCULATOR")
            ' specify the column in which to write (here "C")
            i = .Cells(.Rows.Count, "C").End(xlUp).Row
            Set Rng = .Cells(i + 1, "C").Resize(UBound(Fun), 1)
            Application.ScreenUpdating = False
            Rng.Value = Application.Transpose(Fun)
            Application.ScreenUpdating = True
        End With
    End If
End Sub