Question

我试图通过触摸按钮将目录中的驱动器中的所有文件夹列到Excel电子表格中。我按下按钮并分配了这个宏...为什么不能编译？ *** ****显示了他们调试的内容。所述对象文件夹不是对象。请帮忙！

Sub ListAllFile()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = Worksheets.Add

 'Get the folder object associated with the directory

***Set objFolder = fso.GetFolder("C:hello\EMILY")***
ws.Cells(1, 1).Value = objFolder.Name

 'Loop through the Files collection
For Each objFile In objFolder.Files
    ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
Next


End Sub

Answer 1

这将允许您获取文件夹名称，除非您确实需要文件。它是从您的原始代码修改而来的。我注释掉了excel /工作表逻辑。

部分问题是fso.GetFolder不是声明和设置的对象。如果您仍想要文件，可以将objFolder.Subfolders更改为.Files

Sub ListAllFile()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet

Set objFSO = CreateObject("Scripting.FileSystemObject")
'Set ws = Worksheets.Add

 'Get the folder object associated with the directory

Set objFolder = objFSO.GetFolder("C:\users")
'ws.Cells(1, 1).Value = objFolder.Name

'Loop through the Files collection
For Each objFile In objFolder.subfolders
 MsgBox objFile.Name ' to test output
'ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
Next


End Sub

Answer 2

有很多方法可以做到这一点。这是一种方式。

Option Explicit
Sub FileListingAllFolder()

Dim pPath As String
Dim FlNm As Variant
Dim ListFNm As New Collection ' create a collection of filenames

Dim OWb As Workbook
Dim ShtCnt As Integer
Dim Sht As Integer

Dim MWb As Workbook
Dim MWs As Worksheet
Dim i As Integer

' Open folder selection
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    pPath = .SelectedItems(1)
End With

Application.WindowState = xlMinimized
Application.ScreenUpdating = False

' Create master workbook with single sheets
Set MWb = Workbooks.Add(1)
MWb.Sheets(1).Name = "Result"
Set MWs = MWb.Sheets("Result")
Cells(1, 1) = "No."
Cells(1, 2) = "Sheet Name"
Cells(1, 3) = "File Name"
Cells(1, 4) = "Link"
i = 2

' Filling a collection of filenames (search Excel files including subdirectories)
Call FlSrch(ListFNm, pPath, "*.xls", True)

' Print list to immediate debug window and as a message window
For Each FlNm In ListFNm ' cycle for list(collection) processing

    'Start Processing here
    Set OWb = Workbooks.Open(FlNm)
    ShtCnt = ActiveWorkbook.Sheets.Count
    For Sht = 1 To ShtCnt
        MWs.Cells(i, 1) = i - 1
        MWs.Cells(i, 2) = Sheets(Sht).Name
        MWs.Cells(i, 3) = OWb.Name
        MWs.Cells(i, 4).Formula = "=HYPERLINK(""" & FlNm & """,""Click Here"")"
        i = i + 1
    Next Sht
    'End file processing file
    OWb.Close False
Next FlNm

' Print to immediate debug window and message if no file was found
If ListFNm.Count = 0 Then
    Debug.Print "No file was found !"
    MsgBox "No file was found !"
    MWb.Close False
    End
End If

MWb.Activate
MWs.Activate
Cells.Select
Selection.EntireColumn.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
Application.WindowState = xlMaximized

End

NextCode:
MsgBox "You Click Cancel, and no folder selected!"

End Sub

Private Sub FlSrch(pFnd As Collection, pPath As String, pMask As String, pSbDir As Boolean)

Dim flDir As String
Dim CldItm As Variant
Dim sCldItm As New Collection

' Add backslash at the end of path if not present
pPath = Trim(pPath)
If Right(pPath, 1) <> "\" Then pPath = pPath & "\"

' Searching files accordant with mask
flDir = Dir(pPath & pMask)
    Do While flDir <> ""
        pFnd.Add pPath & flDir 'add file name to list(collection)
        flDir = Dir ' next file
    Loop

' Procedure exiting if searching in subdirectories isn't enabled
If Not pSbDir Then Exit Sub

' Searching for subdirectories in path
flDir = Dir(pPath & "*", vbDirectory)
    Do While flDir <> ""

        ' Add subdirectory to local list(collection) of subdirectories in path
        If flDir <> "." And flDir <> ".." Then If ((GetAttr(pPath & flDir) And _
        vbDirectory) = 16) Then sCldItm.Add pPath & flDir
        flDir = Dir 'next file
    Loop

' Subdirectories list(collection) processing
For Each CldItm In sCldItm
    Call FlSrch(pFnd, CStr(CldItm), pMask, pSbDir) ' Recursive procedure call
Next

End Sub

另外，请查看以下链接。

http://www.learnexcelmacro.com/wp/download/

从名为“文件管理器（Excel工作簿）”的链接中保存文件。这是一个非常酷的应用程序!!

列出我的目录visual basic中的所有文件夹

2 个答案: