Thanks, Ill give it a try... looks like you saved me a bunch of reading


"Bob Phillips" wrote in message
...
Hi Rob,

Want this?

Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long


Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Dim FSO As Object
Dim cnt As Long
Dim arfiles
Dim level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String

Set FSO = CreateObject("Scripting.FileSystemObject")

arfiles = Array()
cnt = -1
level = 1

sFolder = GetFolder
If sFolder < "" Then
ReDim arfiles(1, 0)
SelectFiles sFolder
If SheetExists("Files") Then
Worksheets("Files").Cells.ClearContents
Else
Worksheets.Add.Name = "Files"
End If
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(1,
i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(0, i)
Next
.Columns("A:Z").EntireColumn.AutoFit
End With
End If

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object

If sPath = "" Then
Set FSO = CreateObject("SCripting.FileSystemObject")
sPath = "c:\myTest"
End If

Set Folder = FSO.GetFolder(sPath)

Set Files = Folder.Files
For Each file In Files
cnt = cnt + 1
ReDim Preserve arfiles(1, cnt)
arfiles(0, cnt) = Folder.path & "\" & file.Name
arfiles(1, cnt) = level
Next file

level = level + 1
For Each fldr In Folder.Subfolders
SelectFiles fldr.path
Next

End Sub

'-----------------------------------------------------------------
Function SheetExists(Sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing)
On Error GoTo 0
End Function

'-------------------------------------------------------------
Function GetFolder(Optional ByVal Name)
'-------------------------------------------------------------
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long

If IsMissing(Name) Then Name = "Select a folder."
bInfo.pidlRoot = 0& 'Root folder = Desktop

bInfo.lpszTitle = Name

bInfo.ulFlags = &H1 'Type of directory to Return
oDialog = SHBrowseForFolder(bInfo) 'display the dialog

'Parse the result
path = Space$(512)

GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If

End Function






--

HTH

RP
(remove nothere from the email address if mailing direct)


"Rob" wrote in message
news:HZiJd.27978$IV5.1294@attbi_s54...
Hey folks,

I'm a little rusty with my VBA...

I created a few lines of code that will allow me to insert the names of
each
directory and all of the files from each directory to a word document. I
will eventually pass the same info into an excel sheet. Eventually, I
may
find a need to create a hyperlink to each folder/file but that is way
down
the line. I did it once in JAVA, but lost the code years ago due to
non-use. I also hate JAVA, but thats not the issue here.

My code works perfectly, but I added a full path (i.e "C:\Temp") to my
fuction call.

What I want to do is allow the user to pick the directories to copy using
(what I think is called) a windows common dialog box.

Once I select the folder I wish to start in, I want to pass the full path
to
my function call (in a string variable)

I tried this with with the filedialog property, but you cannot pick a
folder
(you must pick a file)

Any ideas?