-2

Listing files from a directory in an excel sheet? and adding hyperlinks to the results.

Added " With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show On Error Resume Next strTopFolderName = .SelectedItems(1) Err.Clear On Error GoTo 0 End With "

This enabled used selection from a top directory.

Sub ListFiles()

    'Set a reference to Microsoft Scripting Runtime by using
    'Tools > References in the Visual Basic Editor (Alt+F11)

    'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String

    'Insert the headers for Columns A through F
    Range("A1").Value = "File Path"
    Range("B1").Value = "File Size"
    Range("C1").Value = "File Type"
    Range("D1").Value = "Date Created"
    Range("E1").Value = "Date Last Accessed"
    Range("F1").Value = "Date Last Modified"
    Range("G1").Value = "Original Document Date" 

    'Assign the top folder to a variable
    strTopFolderName = "Y:\master-documentation" 'want to be user selectable!

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)

    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)

    'Change the width of the columns to achieve the best fit
    Columns.AutoFit

End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, _
    IncludeSubFolders As Boolean)

    'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long

    'Find the next available row
    NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

    'Loop through each file in the folder
    For Each objFile In objFolder.Files
        Cells(NextRow, "A").Value = objFile.Path
        Cells(NextRow, "B").Value = objFile.Size
        Cells(NextRow, "C").Value = objFile.Type
        Cells(NextRow, "D").Value = objFile.DateCreated
        Cells(NextRow, "E").Value = objFile.DateLastAccessed
        Cells(NextRow, "F").Value = objFile.DateLastModified
        NextRow = NextRow + 1
    Next objFile

    'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If

End Sub
GaryWellock
  • 121
  • 1
  • 1
  • 8

2 Answers2

0

Not entirely sure of your question, but to select a folder, from Excel, you can use this code:

    Dim sTopFolderName As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .ButtonName = "Select Base Directory"
        If .Show = 0 Then Exit Sub
        sTopFolderName = .SelectedItems(1)
    End With
Ron Rosenfeld
  • 53,870
  • 7
  • 28
  • 60
0
'Force the explicit delcaration of variables
'Option Explicit

Sub Auto_Open()
Worksheets("Files").Columns(1).ClearContents
Worksheets("Files").Activate

    'Set a reference to Microsoft Scripting Runtime by using
    'Tools > References in the Visual Basic Editor (Alt+F11)

    'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        On Error Resume Next
            strTopFolderName = .SelectedItems(1)
            Err.Clear
        On Error GoTo 0
    End With
    If strTopFolderName = "" Then Exit Sub

    'Insert the headers for Columns A through G
    Range("A1").Value = "File Path"
    'Range("B1").Value = "File Name"
    'Range("C1").Value = "File Size"
    'Range("D1").Value = "File Type"
    'Range("E1").Value = "Date Created"
    'Range("F1").Value = "Date Last Accessed"
    'Range("G1").Value = "Date Last Modified"

    'Assign the top folder to a variable
    'strTopFolderName = "R:\RA\DM\Labetalol Tab\Dos\100+200mg\NP_BE"

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)

    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)

    'Change the width of the columns to achieve the best fit
    'Columns.AutoFit

End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, _
    IncludeSubFolders As Boolean)

    'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long

    'Find the next available row
    NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

    'Loop through each file in the folder
    For Each objFile In objFolder.Files
        Cells(NextRow, "A").Value = objFile.Path
        'Cells(NextRow, "B").Value = objFile.Name
        'Cells(NextRow, "C").Value = objFile.Size
        'Cells(NextRow, "D").Value = objFile.Type
        'Cells(NextRow, "E").Value = objFile.DateCreated
        'Cells(NextRow, "F").Value = objFile.DateLastAccessed
        'Cells(NextRow, "G").Value = objFile.DateLastModified
        NextRow = NextRow + 1
    Next objFile

    'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If

End Sub

This is exactly what we wanted to do! With a selection box for which directories to look at.

GaryWellock
  • 121
  • 1
  • 1
  • 8