Show full file path

[gibbo1715]

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]

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]

Ken, that works great, many thanks

[Ken Puls]

You're welcome!