List files and select one to transfer to FormField

[road runner]

I have experience with Excel VBA however i have recently been looking at Word, I am trying to create a document were a user can select a file from a user-form and a link will be created in a Form Field. So i don't have to rely on them typing in the correct path ( which they never do)
I have used VBA in excel before using GetOpenFilename, however Word does not support this. I have been looking around and can't find any suitable solution. I have pasted in a excel version of what i was trying to do. Can't remember were i found the code but it does exactly what i need it to do.

Private Sub ListFiles_Click()
Dim arrFiles
Dim I As Integer

arrFiles = Application.GetOpenFilename ' no usable in word

If IsArray(arrFiles) Then
lstFiles.Clear
lstFiles.List = arrFiles
End If

End Sub

Private Sub SelectFiles_Click()
Dim rng As Range
Dim I As Integer

Set rng = ActiveSheet.Range("A1") 'will be Form Filed

For I = 0 To lstFiles.ListCount - 1
If lstFiles.Selected(I) Then
rng.Value = lstFiles.List(I)
Set rng = rng.Offset(1, 0)
End If
Next I

End Sub
Thanks in advance for any help.

[gmaxey]

Here is one way using a reference to scripting runtime. Sorry, I don't do this often enough to know if this is good way or if there are better:

Option Explicit
Sub DialogBox()
'Add Microsoft Scripting Runtime to Resourses before running this code
Dim fso As New FileSystemObject
Dim fd As FileDialog
Dim vrtItem As Variant
Dim sDocPath As String
Dim AbsolutePath As String ' path plus full filename
Dim PathNoFile As String ' path, no filename
sDocPath = ActiveDocument.Path & Application.PathSeparator
'Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.Title = "Pick File"
.AllowMultiSelect = True 'False
.Filters.Add "Word Files", "*.doc", 1
.FilterIndex = 1
.InitialFileName = sDocPath
.InitialView = msoFileDialogViewList
If .Show = -1 Then
For Each vrtItem In .SelectedItems
AbsolutePath = fso.GetAbsolutePathName(vrtItem)
PathNoFile = fso.GetParentFolderName(vrtItem)
MsgBox AbsolutePath
MsgBox PathNoFile
Next vrtItem
Else
Exit Sub
End If
End With
End Sub

[road runner]

Thanks for the quick response Gmaxey, I have modified the code slightly so it adds a hyperlink to a book mark, but works like a charm. :thumb

Private Sub InsertButton_Click()
'Add Microsoft Scripting Runtime to Resourses before running this code
Dim fso As New FileSystemObject
Dim fd As FileDialog
Dim vrtItem As Variant
Dim sDocPath As String
Dim AbsolutePath As String ' path plus full filename
Dim PathNoFile As String ' path, no filename
sDocPath = ActiveDocument.Path & Application.PathSeparator
'Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
.Title = "Pick File"
.AllowMultiSelect = True 'False
.Filters.Add "Word Files", "*.doc", 1
.FilterIndex = 1
.InitialFileName = sDocPath
.InitialView = msoFileDialogViewList
If .Show = -1 Then
For Each vrtItem In .SelectedItems
AbsolutePath = fso.GetAbsolutePathName(vrtItem)
PathNoFile = fso.GetParentFolderName(vrtItem)
ChangeFileOpenDirectory PathNoFile
ActiveDocument.Bookmarks("Link").Select
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=AbsolutePath, SubAddress:=""
Next vrtItem
Else
Exit Sub
End If
End With
End Sub