Loop through listboxes in Application.OrganizerCopy

[Marrick13]

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):

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:

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.

[macropod]

Hi Marrick,

It's not clear where your two procedures fit into the overall scheme of things. The first one, with '.AllowMultiSelect = True', suggests it's used to identify the files to be updated. If so, I think the following will work better:

Private Sub CmdTarget_Click()
Dim TargetFile As Variant, i As Long
'Create a FileDialog object as a File Picker dialog box.
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Filters.Clear
  .Filters.Add "All Word Documents", "*.doc; *.dot; *.rtf; *.docx; *.docm; *.dotx; *.dotm", 1
  .AllowMultiSelect = True
  If .Show = -1 Then
    ' User clicked OK
    With ListBox3
      .ColumnCount = 2
      .ColumnWidths = "0; 60"
    End With
    ' Populate the listbox
    For Each TargetFile In .SelectedItems
      ListBox3.AddItem (TargetFile)
      ListBox3.Column(1, i) = Split(TargetFile, "\")(UBound(Split(TargetFile, "\"))) 'gets the filename
      i = i + 1
    Next
    ' Report the file count
    lblTargetCount.Caption = "(" & .SelectedItems.Count & ")"
  Else
    ' User clicked Cancel
    Exit Sub
  End If
End With
End Sub

To loop through the listbox, you could use code like:

Sub Demo()
Dim i As Long
With ListBox3
  For i = 0 To .ListCount - 1
    MsgBox .Column(0, i)
  Next
End With
End Sub

PS: When posting code, please use code tags.

[Marrick13]

Macropod,

Thanks so much for your response.

I tried your suggested code for the Sub CmdTarget_Click() module,
but on the line:

ListBox3.Column(1, i) = Split(TargetFile, "\")(UBound(Split(TargetFile, "\"))) 'gets the filename

I get a run-time error 381 - Could not set the column property. Invalid property array index.

This module worked fine in the version I sent you. Its purpose is to open a file dialog box filtered for Word-type files and populate Listbox3 with the user-selected files (these are the target files to which the styles are to be copied). The problem I'm having is with the Sub CmdCopyStyle_Click module, which I intended to loop through both the styles list and the target files list and copy those styles to those files.

If you need more code to review, or even the userform itself, I would be happy to send you offline. I'm completely at a loss as to how to make this work.

By the way, what are code tags and how do I use them?

[macropod]

Hi Marrick,

I may have mis-read which listbox column your fielnames go in. If so, simply change the '1' in 'ListBox3.Column(1, i)' to point to the right column.

For the code tags, click on the 'Advanced button. The menu bar there has more items, including tags for code, html, etc. For vba code, you can use the code or vba tags.

[Marrick13]

Macropod,

Thanks for your reply, but I don't feel that the Sub CmdTarget_Click() module is the problem. You had the right listbox, but to be sure I changed the column to 2 (as there are only two columns for that box) and got the same error. As I mentioned, there was no error in this module in the code I sent.

The Sub CmdCopyStyle_Click() is what I need help with, as that is where I am trying to double loop through two listboxes to get the styles and target files to feed the OrganizerCopy snippet.

[macropod]

Hi Marrick,

Try the attached. The document has a basic userform with command buttons & listboxes to select files, then do the double-looping.

[Marrick13]

Macropod,

Thanks much for the demo file. I can see that the msgbox does scroll though the styles and files, going thru the styles for the first file and again for the next file (I commented out the Call Box2Populate module because I want to copy only the styles chosen by a user).

That is what I need for the organizercopy code snippet to do to actually copy the styles to the selected files. However, when I shut off the msgbox and activate the organizercopy snippet, I get the same error as before.

I've attached the application itself ("Style Copier Application"), with your demo code added so you can see the whole picture (run the "SelectandApplyStyles" macro to start it). I've commented out the msgbox in Sub CmdCopyStyle_Click and activated the Application.OrganizerCopy snippet.

I've also attached test files I set up to confirm the styles were actually copied, although I haven't needed them because I can't get the copy to work yet: "Template for Headings 1-2" is the "copy from" file that contains headings 1 and 2 modified to a different font and size from the normal template, and "Test1" and "Test2" are the target files which have a smaller font heading 1. You don't need these but they're here if you want to use them.

I appreciate your help!

[macropod]

Hi Marrick,

Try:

Private Sub CmdCopyStyle_Click()
Dim DestDoc As String, x As Long, y As Long
For x = 0 To ListBox3.listcount - 1
  DestDoc = ListBox3.Column(0, x)
  For y = 0 To ListBox2.listcount - 1
    Application.OrganizerCopy Source:=SourceFile, Destination:=DestDoc, _
      Name:=ListBox2.Column(0, y), Object:=wdOrganizerObjectStyles
  Next y
Next x
End Sub

[Marrick13]

This is what I get:

Run-time error 4198
Command failed

Error occurs on the same snippet:

Application.OrganizerCopy Source:=SourceFile, Destination:=DestDoc, _
Name:=ListBox2.Column(0, y), Object:=wdOrganizerObjectStyles

[macropod]

Hi Marrick,

OK, but that's not the "subscript out of range" error you originally mentioned. From my testing error 4198 appears to occur when you try to use OrganizerCopy to copy one of Word's builtin Styles. If you're happy not to work with them, you could modify the PopulateSourceList sub by adding an If test to your 'For Each aStyle In ActiveDocument.Styles' loop, thus:

For Each aStyle In ActiveDocument.Styles
  If aStyle.BuiltIn = False Then
    ListBox1.AddItem (aStyle)
    CountSourceStyles = CountSourceStyles + 1
    lblSourceCount.Caption = "(" & CountSourceStyles & ")"
  End If
Next aStyle

[Marrick13]

Hi Macropod,

Thanks for the code. It's true that error 4198 is a new message, but I wanted to be able to copy the built-in styles - is that not "allowed"? The Word Organizer can copy them, and the purpose of this app is to mimic the Organizer but improve its limitations by copying styles to multiple files and by not defaulting source and target folders to templates and template-type files.

I did discover an error in the code when choosing "Show only styles in use" but just fixed it. However, if I choose "Show all styles" and select the "Template for Headings 1-2.doc" as the source, I get 8 styles. If I click "Show only styles in use" and select the same file, I get 29 styles.

I must have had the idea that styles in use would be equal to or less than the built-ins, but perhaps not. So is there a way to copy multiple built-in styles to multiple files? The target files will likely have the same built-in styles, but of course some of the source built-in styles could be different from the target ones, and this is why I want to mass copy them as well.

I've attached the repaired application so you can see the changes.

[Marrick13]

Macropod,

Forgot to add that when I choose Test1 and Test2 as the target files, the styles are copied only to Test2, regardless of which sequence they appear in the listbox. This tells me that the copy is not looping through the target files.

[macropod]

Hi Marrick,

Originally Posted by Marrick13

It's true that error 4198 is a new message, but I wanted to be able to copy the built-in styles - is that not "allowed"? The Word Organizer can copy them, and the purpose of this app is to mimic the Organizer but improve its limitations by copying styles to multiple files and by not defaulting source and target folders to templates and template-type files.

An update:
I've narrowed down the problem Styles to the following list (based on what's in a test document I'm using):

1 / 1.1 / 1.1.1
1 / a / i
Article / Section
Comment Reference
Emphasis
Endnote Reference
FollowedHyperlink
Footnote Reference
HTML Acronym
HTML Cite
HTML Code
HTML Definition
HTML Keyboard
HTML Sample
HTML Typewriter
HTML Variable
Hyperlink
Line Number
Page Number
Strong
Table 3D effects 1
Table 3D effects 2
Table 3D effects 3
Table Classic 1
Table Classic 2
Table Classic 3
Table Classic 4
Table Colorful 1
Table Colorful 2
Table Colorful 3
Table Columns 1
Table Columns 2
Table Columns 3
Table Columns 4
Table Columns 5
Table Contemporary
Table Elegant
Table Grid
Table Grid 1
Table Grid 2
Table Grid 3
Table Grid 4
Table Grid 5
Table Grid 6
Table Grid 7
Table Grid 8
Table List 1
Table List 2
Table List 3
Table List 4
Table List 5
Table List 6
Table List 7
Table List 8
Table Professional
Table Simple 1
Table Simple 2
Table Simple 3
Table Subtle 1
Table Subtle 2
Table Theme
Table Web 1
Table Web 2
Table Web 3

I don't know what's special about them, but at least we know it's not all built-in Styles.

[Marrick13]

That's odd...they look like built-ins to me. I didn't create them, so where could they have come from and why are they creating a copying problem? I don't know much about styles from a coding standpoint (or much about coding itself, for that matter!). Maybe the answer is to add an error trap and a message showing which styles were not copied and leave it at that? Do you have any other suggestions?

[macropod]

Yes, they are built-ins, but clearly they don't account for all built-in Styles. An error trap is exactly what I used to generate the list. What I haven't been able to figure out yet is why those particular Styles generate an error, but the other built-ins etc don't. if you're happy with an error report, try:

Private Sub CmdCopyStyle_Click()
Dim DestDoc As String, x As Long, y As Long, StrSty As String, StrList As String
For x = 0 To ListBox3.ListCount - 1
  DestDoc = ListBox3.Column(0, x)
  For y = ListBox2.ListCount - 1 To 0 Step -1
    StrSty = ListBox2.Column(0, y)
    On Error Resume Next
    Application.OrganizerCopy Source:=SourceFile, Destination:=DestDoc, _
      Name:=StrSty, Object:=wdOrganizerObjectStyles
    If Err.Number = 4198 Then
      If x = 0 Then StrList = vbCr & StrSty & StrList
      ListBox2.RemoveItem (y)
    End If
    Err.Clear
  Next y
Next x
If StrList <> "" Then MsgBox "Unable to copy the following Styles:" & StrList
End Sub

After the first pass, all the errant Styles will have been deleted from the 'Selected Styles' box and, on completion (after the error report), only the copied Styles will remain there.