VBA Excel:将每个结果转换成单元格？计数器不工作了吗？
VBA Excel:将每个结果转换成单元格？计数器不工作了吗？
提问于 2017-12-10 16:23:35
我正在创建一个宏，它爬行到子文件夹中，并检索一些文件的名称。我使用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求求你救命！
回答 1
Stack Overflow用户
回答已采纳
发布于 2017-12-10 19: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正如您所看到的，我没有指定目标范围，只指定了工作表和列(我选择了列C；请根据需要在ListFiles子中进行更改)。请注意，代码将新列表追加到所指示列的现有内容。
有两件事是代码做不到让我完全满意的。其一，它不会写入空列C的第一行，而是将第一行保留为空。你可能真的会喜欢。第二，它不执行子文件夹。文件名仅从选定的文件夹及其直接子文件夹中提取。如果需要，任何一个额外的功能都需要额外的编程。
最后，我承认我没有测试列表到工作表的正确传输。我认为它工作正常，但您应该检查您的工作表列中是否列出了名字和姓氏。它们是从文件夹中提取出来的，但可能在写入工作表时遗漏了它们，这是在这种特定方法中发生的典型错误。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/47737106
复制相关文章
相似问题
腾讯云开发者
