I am trying to build a Word userform that works like the Organizer but which will allow one to select a source file (Word only, but not necessarily a template), select any number of its styles, then choose target Word documents to which the code will copy those styles. This is primarily for those instances where one wants to apply specific styles to a large number of existing documents.
Those styles might or might not be stored in a template - they might be in a regular document that has been reformatted. The Organizer file type and path always defaults to template type and template folder, and this utility will not do that. The Organizer also shows only styles in use and allows one to copy styles only to one document at a time. This utility offers the options of showing either styles in use or all styles including builtins, because people can modify builtins and may want to copy them to multiple documents.
The idea is also to copy the styles from a source to target documents without opening those documents (except that I have to open the source to get its styles and populate a listbox as an active document).
I am a VBA novice who has never worked with arrays but I have determined that this functionality requires arrays; in fact, a "double array loop" in the code snippet "Application.OrganizerCopy." I am getting a "subscript out of range" error when this snippet runs.
First, here is the code that gets the target files to which the selected styles are to be copied.
I want to show only the document name and extension in the listbox but include the path so the code can find the file. I thought a way of doing this was to set the listbox for 2 columns, hide the one with the path and show the one with the document name (I'm sure there is code that will show only the doc name and retain the path for accessing the files, but I thought the 2-column approach would work. However, even when I made the listbox 1 column I still had the same problem):
Code:
Private Sub CmdTarget_Click()
'Create a FileDialog object as a File Picker dialog box.
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
.Filters.Clear
.AllowMultiSelect = True
.Filters.Add "All Word Documents", "*.doc; *.dot; *.rtf; *.docx; *.docm; *.dotx; *.dotm", 1
If .Show = -1 Then
'clicked OK
TargetFile = .SelectedItems(1) 'get selected path, file name and extension for source
With ListBox3
.ColumnCount = 2
.ColumnWidths = "0; 60"
End With
For Each TargetFile In .SelectedItems
TargetFile = WordBasic.FileNameInfo$(TargetFile, 2) 'gets new filename
TargetFilename = WordBasic.FileNameInfo$(TargetFile, 1) 'gets new filename and path
ListBox3.AddItem (TargetFilename)
ListBox3.Column(1, ListBox3.ListCount - 1) = TargetFile
CountTargetFiles = CountTargetFiles + 1
lblTargetCount.Caption = "(" & CountTargetFiles & ")"
Next
End If
End With
' Else
'user canceled
Exit Sub
End Sub
This is the code for the style copy:
Code:
Private Sub CmdCopyStyle_Click()
Dim SourceDoc As String
Dim styleNames() As Variant
Dim DestDocs() As Variant
Dim x As Long
Dim y As Long
ReDim styleNames(ListBox2.ListCount - 1)
styleNames() = Me.ListBox2.List
DestDocs() = Me.ListBox3.Column(0)
For x = 0 To UBound(DestDocs)
For y = 0 To UBound(styleNames)
Application.OrganizerCopy _
Source:=SourceFile, _
Destination:=DestDocs(x), _
Name:=styleNames(y), _
Object:=wdOrganizerObjectStyles
Next y
Next x
End Sub
I've tried various Redim statements and loops, all to no avail. I cannot get the code to loop through either the listbox2 (containing the selected styles) or listbox3 (containing the target documents). I get a run-time error 9 subscript out of range error. The problem is with the 'Destination:=DestDocs(x)' and 'Name:=styleNames(y)' parts as these are supposed to read the listboxes as the code loops through them.
I have been searching for days and days trying to find some code I can adapt to serve this purpose but have been unsuccessful so far.