PDA

View Full Version : [SOLVED] Show full file path



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

Ken Puls
02-06-2005, 03:45 PM
Hi Gibbo,

Try entering the following in your Userform's code module (you will still need to load the userform from some other proc):


Option Explicit
Dim FileDir As String 'Global variable to hold the directory

Private Sub CommandButton1_Click()
Dim AppObj As Object, i As Integer
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
Set AppObj = GetObject(FileDir & "\" & ListBox1.List(i) & ".doc")
AppObj.Application.Visible = True
Exit For
End If
Next i
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim fso As Object, _
ShellApp As Object, _
File As Object, _
SubFolder As Object, _
Directory As String, _
Problem As Boolean, _
ExcelVer As Integer
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
Do
Problem = False
Set ShellApp = CreateObject("Shell.Application"). _
Browseforfolder(0, "Please choose a folder", 0, "c:\my documents")
On Error Resume Next
Directory = ShellApp.self.Path
Set SubFolder = fso.GetFolder(Directory).Files
If Err.Number <> 0 Then
If MsgBox("You did not choose a valid directory!" & vbCrLf & _
"Would you like to try again?", vbYesNoCancel, _
"Directory Required") <> vbYes Then Exit Sub
Problem = True
End If
On Error GoTo 0
Loop Until Problem = False
Listbox1.rowsource = ""
For Each File In SubFolder
If Right(File.Name, 3) = "doc" Then _
Me.ListBox1.AddItem Left(File.Name, Len(File.Name) - 4)
Next File
FileDir = Directory
End Sub

It doesn't need the BrowseFolder routine or API's you were using. If you want to set the default directory, change the "C:\My Documents" to a variable.

This will work with Word Documents only.

Let me know if you need any help with it.

Cheers,

gibbo1715
02-07-2005, 12:27 AM
Ken, that works great, many thanks

Ken Puls
02-07-2005, 10:07 AM
You're welcome!