View Single Post
 
Old 10-10-2020, 10:43 AM
John 4 John 4 is offline Windows 10 Office 2013
Advanced Beginner
 
Join Date: Oct 2019
Posts: 69
John 4 is on a distinguished road
Default Applying heading styles from normal template to all files in a folder

I got the code below from one of Macropod's posts on another thread. I recorded a macro of me applying the Styles to one of the desired files and was hoping I could cut and paste with a little modification to get it to work in Macropod's macro. The entire macro i recorded isn't here, just one relevant part (and the most relevant part of that is bolded).

I had hoped something like "strFolder\strFile" in the place of the bolded section would work, but of course it doesn't. Could one of you do whatever tweaking is necessary to get it work please? Thanks for your help.


Code:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName: strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  If strFolder & "" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc

      'Call your other macro or insert its code here
          With ActiveDocument
        .UpdateStylesOnOpen = False
        .AttachedTemplate = "Normal"
    End With
    Application.OrganizerCopy Source:= _
        "C:\Users\MyName\AppData\Roaming\Microsoft\Templates\Normal.dotm", _
        Destination:= _
        "C:\Users\MyName\Documents\FolderName\FileName.docx" _
        , Name:="Default", Object:=wdOrganizerObjectStyles

      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
Reply With Quote