Получение VBA Runtime Ошибка при запуске на C: / или D: /, но нормально работает на c: / test - PullRequest
Новая
       25

Получение VBA Runtime Ошибка при запуске на C: / или D: /, но нормально работает на c: / test

0 голосов
/ 16 апреля 2019 
Public Sub Hierarchical_Folders_and_Files_Listing2()

    Dim startFolderPath As String
    Dim startCell As Range
    Dim n As Long

startFolderPath = Application.ActiveWorkbook.Path

    With Sheets("Sheet1")
        .Cells.Clear
        .Activate
        Set startCell = .Range("A1")
    End With

    n = List_Folders_and_Files2(startFolderPath, startCell)

End Sub




Private Function List_Folders_and_Files2(folderPath As String, destCell As Range) As Long

    Static FSO As Object
    Dim thisFolder As Object, subfolder As Object
    Dim fileItem As Object
    Dim n As Long

    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")

    Set thisFolder = FSO.Getfolder(folderPath)
    'Application.ThisWorkbook.Path

    'FSO.Getfolder(folderPath)

    'Add hyperlink for this folder

    destCell.Parent.Hyperlinks.Add Anchor:=destCell, Address:=thisFolder.Path, TextToDisplay:=thisFolder.Name

    'List subfolders in this folder

    n = 0
    For Each subfolder In thisFolder.SubFolders
        n = n + 1 + List_Folders_and_Files2(subfolder.Path, destCell.Offset(n + 1, 1))
    Next

    'Add hyperlink for each file in this folder

    For Each fileItem In thisFolder.Files
        n = n + 1
        destCell.Offset(n, 1).Parent.Hyperlinks.Add Anchor:=destCell.Offset(n, 1), Address:=fileItem.Path, TextToDisplay:=fileItem.Name
    Next

    List_Folders_and_Files2 = n

End Function
...