Use Excel 2007 to create a File Location and List

[Christopher_Green]

Hi,

I have the below macro that will look in a specific File location / directory and produce me a list of files within that area.

If possible i would like to change the macro so that rather then me going into the VBA to change the location an input message box asks me which file location i want to generate the list from.

I would also then like the Macro to concatenate this information togeather for me to produce the full file path e.g. (C:\Documents and Settings\greenc4\My Documents\Document 1.doc)

The last things is i would like it to produce this information on the same sheet and not add a new one when the macro runs.

I hope this makes sense.

Here is the macro:

Sub List_All_Files()
     
    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:\")
    ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & "are:"
     
     'Loop through the Files collection
    For Each objFile In objFolder.Files
        ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
    Next
     
     'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
     
End Sub

I am thankful for any help you can give.

Thanks

Christopher Green

 

[lrobbo314]

Sub List_Files()
Dim par As String
Dim sfil As String
Dim shellApp As Object
Set shellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, "C:\")
Dim cel As Range
Set cel = ActiveCell
par = shellApp.self.Path
sfil = Dir(par & "\" & "*.*")
    Do Until sfil = ""
        cel.Hyperlinks.Add cel, par & "\" & sfil, , , par & "\" & sfil
        Set cel = cel.Offset(1)
        sfil = Dir$
    Loop
ActiveCell.EntireColumn.AutoFit
End Sub

 

[Christopher_Green]

Hi Irobbo314,

The Macro works great thanks, i changed the location of the macro to "" so that it can pick up from anywhere and not just my C drive.

Here is the amended codes:

Sub List_Files()
Dim par As String
Dim sfil As String
Dim shellApp As Object
Set shellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, "")
Dim cel As Range
Set cel = ActiveCell
par = shellApp.self.Path
sfil = Dir(par & "\" & "*.*")
    Do Until sfil = ""
        cel.Hyperlinks.Add cel, par & "\" & sfil, , , par & "\" & sfil
        Set cel = cel.Offset(1)
        sfil = Dir$
    Loop
ActiveCell.EntireColumn.AutoFit
End Sub

Thanks for your help with this

Chris

 

[lrobbo314]

Cool, glad it worked for you.