Try this:
Code:
Sub DOCXStylesDownload2()
' Copies styles from a template to the active document, then hides
' all styles that do not begin with an underscore
Dim str_Source As String
Dim str_Destination As String
''str_Source = "\\Server\Setup\OfficeTemplates\Automation.dotm"
str_Destination = ActiveDocument.FullName
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
' Pass source and destination paths to a function to copy styles:
Call DOCXStyleCopy2(str_Source, str_Destination)
' Hide styles that don't begin with an underscore:
Call DOCXHideStyles
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox "Error - StylesDownload2"
End Sub
Function DOCXStyleCopy2(strSource As String, strDestination As String)
' Loops through all styles in a document/template and copies them to a document
' if they begin with an underscore
Dim myStyle As Style
Dim objSourceDoc As Document
On Error GoTo ErrorHandler
' Open the source document/template:
Set objSourceDoc = Documents.Open(strSource, ReadOnly:=True)
' Loop through all the styles in the document/template:
For Each myStyle In objSourceDoc.Styles
' If a style begins with an underscore:
If InStr(myStyle.NameLocal, "_") = 1 Then
'...then copy it to the source file:
Application.OrganizerCopy Source:= _
strSource, Destination:= _
strDestination, Name:=myStyle.NameLocal, Object _
:=wdOrganizerObjectStyles
End If
Next myStyle
objSourceDoc.Close
Exit Function
ErrorHandler:
MsgBox "Error StyleCopy2"
End Function
Function DOCXHideStyles()
' Hides all styles that do not begin with an underscore
Dim myStyle As Style
On Error GoTo ErrorHandler
For Each myStyle In ActiveDocument.Styles
' If the style name doesn't begin with _, then hide it:
If InStr(myStyle.NameLocal, "_") <> 1 Then
' Set visibility in the Styles pane:
' NOTE: The VBA setting to HIDE a style is ".Visibility = True" (thanks, Microsoft...):
myStyle.Visibility = True
End If
Next myStyle
Exit Function
ErrorHandler:
MsgBox "Error DOCXHideStyles"
End Function