gibbo1715
02-06-2005, 11:59 AM
Hello all
I need to ask my user to select a folder and when they do list the word documents contained in that folder in a list box on a user form
I then need to be able to give my users the ability to open the document
I ve made a start but not sure how to get this to store the full file path and only display the doc name in the list box
the code below is run from a userform
I would also like it to default open on this workbook directory
Any Ideas
Dim fs, f, f1, s, sf, iRow, dir
Dim Cell As Range
Dim Rng As Range
Dim FName As String
MsgBox " Please Select The Folder Containing your Word Documents", vbOKOnly, " "
FName = BrowseFolder("Select A Folder")
If FName = "" Then
MsgBox " You must select somewhere", vbOKOnly, " "
Exit Sub
End If
Sheets("WordDocs").Select
ActiveSheet.UsedRange.ClearContents
On Error Resume Next
Me.ListBox1.Clear
Set fs = CreateObject("Scripting.FileSystemObject")
On Error GoTo error
dir = FName
Set f = fs.GetFolder(dir)
Set sf = f.Files
iRow = 3
For Each f1 In sf
Cells(iRow, 1) = Left(f1.name, Len(f1.name)) '-4 to hide extention
iRow = iRow + 1
Next
With ThisWorkbook.Sheets("WordDocs")
Set Rng = .Range("A3", .Range("A65536").End(xlUp))
End With
For Each Cell In Rng.Cells
With Me.ListBox1
.AddItem Cell.value
.List(.ListCount - 1, 1) = Cell.Offset(0, 1).value
End With
Next Cell
Exit Sub
error:
MsgBox "The Directory does not exist in this location"
Unload Me
I need to ask my user to select a folder and when they do list the word documents contained in that folder in a list box on a user form
I then need to be able to give my users the ability to open the document
I ve made a start but not sure how to get this to store the full file path and only display the doc name in the list box
the code below is run from a userform
I would also like it to default open on this workbook directory
Any Ideas
Dim fs, f, f1, s, sf, iRow, dir
Dim Cell As Range
Dim Rng As Range
Dim FName As String
MsgBox " Please Select The Folder Containing your Word Documents", vbOKOnly, " "
FName = BrowseFolder("Select A Folder")
If FName = "" Then
MsgBox " You must select somewhere", vbOKOnly, " "
Exit Sub
End If
Sheets("WordDocs").Select
ActiveSheet.UsedRange.ClearContents
On Error Resume Next
Me.ListBox1.Clear
Set fs = CreateObject("Scripting.FileSystemObject")
On Error GoTo error
dir = FName
Set f = fs.GetFolder(dir)
Set sf = f.Files
iRow = 3
For Each f1 In sf
Cells(iRow, 1) = Left(f1.name, Len(f1.name)) '-4 to hide extention
iRow = iRow + 1
Next
With ThisWorkbook.Sheets("WordDocs")
Set Rng = .Range("A3", .Range("A65536").End(xlUp))
End With
For Each Cell In Rng.Cells
With Me.ListBox1
.AddItem Cell.value
.List(.ListCount - 1, 1) = Cell.Offset(0, 1).value
End With
Next Cell
Exit Sub
error:
MsgBox "The Directory does not exist in this location"
Unload Me