See the following page of fellow MVP Greg Maxey's website :
http://gregmaxey.mvps.org/Create_and_employ_a_UserForm.htm
If you create a userform with the followings controls starting from the top
A textbox with the name of txtDocFolder and to the right of that a command
button with the name cmdListLocation
Under the textbox, a listbox with the name of lstDocuments and the caption
"Select File Location"
To the right of the lstDocuments listbox a a SpinButton with the name of
SpinButton1
Under the lstDocuments list box, a command button with the name cmdCompile
and the caption "Compile Documents", a command button with the name
cmdCancel and the caption "Cancel", a command button with the name cmdDelete
and the caption "Delete: and a command button with the name cmdDeleteAll and
the caption "Delete All"
And, also a listbox with the name Temp with its Visible property set to
False
And you have the following code in the UserForm
Option Explicit
Dim i As Long
Dim j As Long
Dim fd As FileDialog
Dim FileName As String
Dim source As String
Private Sub cmdCompile_Click()
Me.Hide
Dim mdoc As Document
Dim mrange As Range
Dim i As Long
Dim tocRange As Range, prange As Range
Set mdoc = Documents.Open(txtDocFolder.Text & "\" & lstDocuments.List(0, 0))
With mdoc
For i = 1 To lstDocuments.ListCount - 1
Set mrange = .Range
mrange.Collapse wdCollapseEnd
mrange.InsertFile txtDocFolder.Text & "\" & lstDocuments.List(i, 0)
Next i
.SaveAs txtDocFolder.Text & "\Compiled - " & Format(Date, "yyyymmdd")
End With
End Sub
Private Sub cmdCancel_Click()
Me.Hide
End Sub
Private Sub cmdDelete_Click()
With lstDocuments
For i = 0 To .ListCount - 1
If .Selected(i) Then
.RemoveItem (i)
End If
Next i
If .ListCount = 0 Then
cmdCompile.Enabled = False
txtDocFolder.Text = ""
End If
End With
End Sub
Private Sub cmdDeleteAll_Click()
With lstDocuments
For i = .ListCount - 1 To 0 Step -1
.RemoveItem (i)
Next i
End With
cmdCompile.Enabled = False
txtDocFolder.Text = ""
End Sub
Private Sub cmdListLocation_Click()
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.AllowMultiSelect = False
.Title = "Select the folder that contains the Lists"
If .Show = -1 Then
source = .SelectedItems(1)
txtDocFolder.Text = source
FileName = Dir$(source & "\*.*")
Do While FileName <> ""
lstDocuments.AddItem FileName
FileName = Dir
Loop
If lstDocuments.ListCount > 0 Then
cmdCompile.Enabled = True
End If
Else
Set fd = Nothing
Exit Sub
End If
End With
Set fd = Nothing
End Sub
Private Sub SpinButton1_SpinDown()
For i = 0 To lstDocuments.ListCount - 1
If lstDocuments.Selected(i) Then
If i = lstDocuments.ListCount - 1 Then
Temp.AddItem
Temp.List(0, 0) = lstDocuments.List(i, 0)
' Temp.List(0, 1) = lstDocuments.List(i, 1)
For j = 1 To lstDocuments.ListCount - 1
Temp.AddItem
Temp.List(j, 0) = lstDocuments.List(j - 1, 0)
' Temp.List(j, 1) = lstDocuments.List(j - 1, 1)
Next j
lstDocuments.List = Temp.List
For j = Temp.ListCount To 1 Step -1
Temp.RemoveItem (j - 1)
Next j
Exit For
Else
Temp.AddItem
Temp.List(0, 0) = lstDocuments.List(i + 1, 0)
' Temp.List(0, 1) = lstDocuments.List(i + 1, 1)
lstDocuments.List(i + 1, 0) = lstDocuments.List(i, 0)
' lstDocuments.List(i + 1, 1) = lstDocuments.List(i, 1)
lstDocuments.List(i, 0) = Temp.List(0, 0)
' lstDocuments.List(i, 1) = Temp.List(0, 1)
lstDocuments.ListIndex = i + 1
Temp.RemoveItem (0)
Exit For
End If
End If
Next i
End Sub
Private Sub SpinButton1_SpinUp()
For i = 0 To lstDocuments.ListCount - 1
If lstDocuments.Selected(i) Then
If i = 0 Then
For j = 1 To lstDocuments.ListCount - 1
Temp.AddItem
Temp.List(j - 1, 0) = lstDocuments.List(j, 0)
' Temp.List(j - 1, 1) = lstDocuments.List(j, 1)
Next j
Temp.AddItem
Temp.List(Temp.ListCount - 1, 0) = lstDocuments.List(0, 0)
' Temp.List(Temp.ListCount - 1, 1) = lstDocuments.List(0, 1)
lstDocuments.List = Temp.List
For j = Temp.ListCount To 1 Step -1
Temp.RemoveItem (j - 1)
Next j
Exit For
Else
Temp.AddItem
Temp.List(0, 0) = lstDocuments.List(i - 1, 0)
' Temp.List(0, 1) = lstDocuments.List(i - 1, 1)
lstDocuments.List(i - 1, 0) = lstDocuments.List(i, 0)
' lstDocuments.List(i - 1, 1) = lstDocuments.List(i, 1)
lstDocuments.List(i, 0) = Temp.List(0, 0)
' lstDocuments.List(i, 1) = Temp.List(0, 1)
lstDocuments.ListIndex = i - 1
Temp.RemoveItem (0)
Exit For
End If
End If
Next i
End Sub
Private Sub UserForm_Activate()
cmdCompile.Enabled = False
End Sub
When you run the userform and click on the Select File Location button, a
dialog will appear that will allow you to select the folder that contains
the files. After doing that, the names of the files from that folder will
appear in the lstDocuments listbox and if necessary, you can use the
SpinButtons to re-arrange the order of the files, or delete individual
files, (or all of them if you want to start again). Then when you have the
list the way that you want it, if you click on the Compile Documents button,
the first file in the list will be opened and the other files will be
appended to it. The combined file will then be saved into the folder that
was selected with the a filename Compiled - yyyymmdd.
--
Hope this helps.
Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.
Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
