Results 1 to 5 of 5
  1. #1
    New Lounger
    Join Date
    Sep 2013
    Posts
    2
    Thanks
    1
    Thanked 0 Times in 0 Posts

    copy and paste document names into a spreadsheet

    Is it possible to copy and paste document names from a folder into a spreadsheet - quickly? I have about 500 documents in an Excel folder and I want to copy the names of the documents into a spreadsheet for sorting and reporting purposes.

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    This is a procedure I often use. It prompts for a filename, pick any file in the main folder, it will go into all the subfolders of that folder. It lists the
    Folder name
    File name
    File size (in bytes)
    File last modified
    File last accessed
    File created

    Steve

    Code:
    Option Explicit
    Dim x As Long
    Dim fso As Object
    Dim strPath As String
    Dim result As Boolean
    Dim lngRow As Long
    
    Sub SubFolderInfo()
        Dim bOldStatusbar As Boolean
        On Error GoTo ErrHandler
        
        With Application
            .ScreenUpdating = False
            bOldStatusbar = .DisplayStatusBar
            .DisplayStatusBar = True
            .StatusBar = "Processing..."
        End With
        
        strPath = Application.GetOpenFilename
        If strPath = "False" Then Exit Sub
        
        Workbooks.Add
        
        Do Until Right(strPath, 1) = "\"
            strPath = Mid(strPath, 1, Len(strPath) - 1)
        Loop
        
        Range("a1").Value = "Folder name"
        Range("b1").Value = "File name"
        Range("c1").Value = "File size (in bytes)"
        Range("d1").Value = "File last modified"
        Range("e1").Value = "File last accessed"
        Range("f1").Value = "File created"
        
        Range("A1:b1").ColumnWidth = 40
        Range("c1:f1").ColumnWidth = 20
        x = 2
    
        Set fso = CreateObject("Scripting.FileSystemObject")
        
        result = ExtractFileInfo(strPath)
        
        Range("A2").Select
        ActiveWindow.FreezePanes = True
    
        Set fso = Nothing
        MsgBox "DONE"
    ExitHandler:
        With Application
            .ScreenUpdating = True
            .StatusBar = False
            .DisplayStatusBar = bOldStatusbar
        End With
        Exit Sub
    
    ErrHandler:
        MsgBox Err.Number & Err.Description
        Resume ExitHandler
        
    End Sub
    
    Private Function ExtractFileInfo(fspec)
        Dim fldr As Object, fi As Object, sfldr As Object
        Set fldr = fso.GetFolder(fspec)
        
        On Error GoTo ErrHandler
    
        If fldr.Files.Count <> 0 Then
            For Each fi In fldr.Files
                Application.StatusBar = "Files Processed: " & Format(x, "#,##0")
                Cells(x, 1).Value = fspec
                Cells(x, 2).Value = fi.Name
            
                Range(Cells(x, 3), Cells(x, 6)).Value = "access disallowed"
            
                Cells(x, 3).Value = fi.Size
                Cells(x, 4).Value = fi.datelastmodified
                Cells(x, 5).Value = fi.datelastaccessed
                Cells(x, 6).Value = fi.datecreated
    
    accessnotallowed:
                x = x + 1
            Next
        End If
    
        If fldr.SubFolders.Count > 0 Then
            For Each sfldr In fldr.SubFolders
                ExtractFileInfo (sfldr)
            Next
        End If
    permissiondenied:
    
        ExtractFileInfo = True
        Set fldr = Nothing
    
    ExitHandler:
        Application.ScreenUpdating = True
        Exit Function
    
    ErrHandler:
        If Err.Number = 70 Then 'permission denied
            Err.Clear
            Cells(x, 1).Value = fspec
            Cells(x, 2).Value = "Permission Denied"
            x = x + 1
            Resume permissiondenied
        Else
            MsgBox Err.Number & ": " & Err.Description
            Resume ExitHandler
        End If
    End Function

  3. The Following User Says Thank You to sdckapr For This Useful Post:

    cmonson (2013-09-27)

  4. #3
    New Lounger
    Join Date
    Sep 2013
    Posts
    2
    Thanks
    1
    Thanked 0 Times in 0 Posts

    copy and paste names into a spreadsheet

    Steve, Sorry to be so lame. How do I utilize this code?

  5. #4
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Not sure exactly how detailed you need or what you experience is. Look at the tutorial at http://www.contextures.com/xlvba01.html. I think this walks you through the process. If you additional questions let me know.

    Steve

  6. #5
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 651 Times in 593 Posts
    Cmonson,

    Steve's code will list files in a folder and subfolders on to a new workbook. If you are looking to list the files from a specific folder onto the current worksheet, then here is some code for your review.

    Code:
    Public Sub ListFiles()
    On Error Resume Next
    'DECLARE AND SET VARIABLES
    Dim ShellApplication As Object
    Set ShellApplication = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    Path = ShellApplication.self.Path
    Set ShellApplication = Nothing
    Filename = Dir(Path & "\*.*")
    '--------------------------------------------
    'GET FILENAMES AND LIST ON CURRENT WORKSHEET
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Do While Len(Filename) > 0
        Cells(LastRow, 1).Value = Filename
        LastRow = LastRow + 1
        Filename = Dir
    Loop
    End Sub
    HTH,
    Maud
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •