View Single Post
 
Old 07-25-2018, 04:10 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,176
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

If you are learning vba, there is a good article that you should read which happens to include the OrganizerCopy method in it. See https://wordmvp.com/FAQs/MacrosVBA/MaintainableCode.htm

The macro provided at the bottom of that page can be simplified to suit your purposes. It is not exactly the same as your code and wouldn't import fresh style definitions if the stylename already exists in the target doc. By removing the StyleIsMissing parts you can copy the style every time regardless of whether the style already exists or not.

Try this version. It doesn't test whether the ActiveDocument is read only or has style restrictions but if it fails then it is going to be much easier to pinpoint the problem. You can set the source file path to whatever suits you.
Code:
Sub ImportMyStyles()
  Dim StyleArray() As String, i As Long, sSource As String, sTarget As String
  
  sSource = NormalTemplate.FullName   '"C:\Users\myname\Desktop\EXAMPLE.docx"
  sTarget = ActiveDocument.FullName
  ActiveDocument.UpdateStylesOnOpen = False
  
  If ActiveDocument.Path = "" Or Dir(sSource) = "" Then
    MsgBox "One of these doesn't exist:" & vbCr & sTarget & vbCr & sSource, vbOKOnly, "Problem Encountered"
    Exit Sub
  End If

  StyleArray = Split("Caption-Photo|Heading 1|Heading 2", "|")    'list of styles to be copied here separated by a vertical bar
  
  On Error Resume Next                                            'don't throw an error if the style doesn't exist in the source doc
  For i = LBound(StyleArray) To UBound(StyleArray)
    Application.OrganizerCopy Source:=sSource, Destination:=sTarget, Name:=StyleArray(i), Object:=wdOrganizerObjectStyles
  Next i
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote