When you say you want to import contents, I'm assuming you want to bring
file and folder names into your worksheet. Put these two subroutines into a
module and then run the subroutine "DoNewFolder()". It will give you a
folder browse window to select a top level folder and then present you with
a message box asking if you want to include subfolders in the listing. It
will add a new workbook where the information will be placed and you can
choose to save that workbook or not.

Sub DoNewFolder()
Application.ScreenUpdating = False
Workbooks.Add
Dim strPath As String
Dim inclSubs As Boolean

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Select Folder", 0)
If objFolder Is Nothing Then
Exit Sub
Else
strPath = objFolder.Self.Path
End If

If MsgBox("Include Subfolders?", vbYesNo, "Scope") = vbYes Then
inclSubs = True
Else
inclSubs = False
End If

With Range("A1")
.Formula = "Folder Contents: " & strPath
.Font.Bold = True
.Font.Size = 12
End With

Range("A3").Formula = " "
Range("B3").Formula = "File Name"
Range("C3").Formula = "Date Created"
Range("D3").Formula = "Date Last Modified"
Range("E3").Formula = "Date Last Accesssed"
Range("A3:E3").Font.Bold = True

Range("A2").Select

ListFilesInFolder strPath, inclSubs

Application.ScreenUpdating = True

End Sub

Sub ListFilesInFolder(SourceFolderName As String, AlsoSubfolders As Boolean)
Application.ScreenUpdating = False

Dim R As Long

Set fso = CreateObject("Scripting.FileSystemObject")
Set objStartFolder = fso.GetFolder(SourceFolderName)

R = Range("A65536").End(xlUp).Row + 1

For Each itmFile In objStartFolder.Files
Cells(R, 1).Formula = " "
Cells(R, 2).Formula = itmFile.Name
Cells(R, 3).Formula = itmFile.DateCreated
Cells(R, 4).Formula = itmFile.DateLastModified
Cells(R, 5).Formula = itmFile.DateLastAccessed
R = R + 1
Next itmFile

If AlsoSubfolders Then
For Each itmSub In objStartFolder.Subfolders
R = Range("A65536").End(xlUp).Row + 1
Cells(R, 1).Formula = itmSub.Path
ListFilesInFolder itmSub.Path, True
Next itmSub
End If

Columns("B:E").AutoFit

Set objStartFolder = Nothing
Set fso = Nothing

End Sub



Steve Yandl



"asummers" wrote in
message ...

Afternoon Guys.

Wondered if someone could help me.

I have a series of folders in Windows and I would like to import them,
their contents and the contents of any subfolders into an Excel file.
Does anyone know of a way I can do this either within Excel or using
third-party software?

Many thanks,

Andrew Summers :)


--
asummers
------------------------------------------------------------------------
asummers's Profile:
http://www.excelforum.com/member.php...o&userid=31807
View this thread: http://www.excelforum.com/showthread...hreadid=515294