#1
|
|||
|
|||
Replace font (multiple files)
I am trying to replace font Arial with Calibri on multiple docx files on folders+subfolders.
This code I found it's not working on subfolders. Can anyone, please, help to add this part? Code:
Sub BatchReplaceFont() Dim objDoc As Document Dim objSingleWord As Range Dim strFile As String, strFolder As String strFolder = "C:\Users\Test\Desktop\test files\" strFile = Dir(strFolder & "*.docx", vbNormal) While strFile <> "" Set objDoc = Documents.Open(FileName:=strFolder & strFile) For Each objSingleWord In objDoc.Words If objSingleWord.Font.Name = "Arial" Then objSingleWord.Font.Name = "Calibri" End If Next objSingleWord objDoc.Save objDoc.Close strFile = Dir() Wend End Sub |
#2
|
||||
|
||||
For example:
Code:
Option Explicit Dim FSO As Object, oFolder As Object, StrFolds As String Sub Main() Dim TopLevelFolder As String, TheFolders As Variant, aFolder As Variant, i As Long TopLevelFolder = GetFolder If TopLevelFolder = "" Then Exit Sub StrFolds = vbCr & TopLevelFolder If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject") End If 'Get the sub-folder structure Set TheFolders = FSO.GetFolder(TopLevelFolder).SubFolders For Each aFolder In TheFolders RecurseWriteFolderName (aFolder) Next 'Process the documents in each folder For i = 1 To UBound(Split(StrFolds, vbCr)) Call UpdateDocuments(CStr(Split(StrFolds, vbCr)(i))) Next End Sub Sub RecurseWriteFolderName(aFolder) Dim SubFolders As Variant, SubFolder As Variant Set SubFolders = FSO.GetFolder(aFolder).SubFolders StrFolds = StrFolds & vbCr & CStr(aFolder) On Error Resume Next For Each SubFolder In SubFolders RecurseWriteFolderName (SubFolder) Next End Sub Sub UpdateDocuments(oFolder As String) Application.ScreenUpdating = False Dim strInFolder As String, strFile As String, wdDoc As Document, wdStry As Range, wdStl As Style strInFolder = oFolder strFile = Dir(strInFolder & "\*.doc", vbNormal) While strFile <> "" Set wdDoc = Documents.Open(FileName:=strInFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc For Each wdStl In .Styles With wdStl.Font If .Name = "Arial" Then .Name = "Calibri" End With Next For Each wdStry In .StoryRanges With wdStry.Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindContinue .Format = True .Text = "" .Replacement.Text = "" .Font.Name = "Arial" .Replacement.Font.Name = "Calibri" .Execute Replace:=wdReplaceAll End With Next 'Save and close the document .Close SaveChanges:=True End With 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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thank you very much. This is unexpected.
I have one question. On some files, after replacing font, the size of docx is increased. This is because the size of styles.xml inside docx is increased up to 20 times. Is this normal? I noticed that the code from post 1 has no such problem. Last edited by w64bit; 06-08-2022 at 10:57 AM. |
#4
|
||||
|
||||
Changing the font in the Style definitions is unlikely to have any such effect. What will cause bloat is overriding the Style definitions. Both your code and mine (to a lesser extent) do that. Mine does it less so because, having changed the Style definitions, there is less (if any) content in the document that will have content that is inconsistent with the underlying Style definitions.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
I attached 2 styles.
- styles1 resulted from initial code - styles2 resulted from your code styles2 is 20 times larger. If I change all text manually (ctrl+a + change to Calibri), I obtain the smaller styles file. |
#6
|
||||
|
||||
I would say it is better to have the styles.xml bloat than it is to have document.xml bloat. Using local formatting to change globally to Calibri would result in document.xml being unduly cluttered whereas a style change (conceptually) should be more more discrete.
I don't see why running Paul's code would cause the default style settings to suddenly appear in the Styles.xml file but I am surprised they weren't there in the first place. I assume that the document had never modified any style definitions and therefore it was using the built-in style definitions to build this information on the fly. Did you create your docx file from the GUI or are you using code to create the document? It is unusual for people posting on this forum to go digging in the xml components so I assume you are using advanced processing methods that may not be typical Word users methods.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#7
|
|||
|
|||
Quote:
The original file it's created in GUI Word 2003 as *.doc and saved in 2019 as *.docx. Can something be added to Paul's code in order to "clean", "reset" or "recreate from scratch" the file styles.xml (and maybe document.xml) in order to keep only the necessary data and to purge unnecessary/duplicated data? |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Replace or apply new header in multiple files | Carchee | Word VBA | 41 | 01-26-2024 07:27 AM |
Replace lines of text from header in multiple files | PolarPop | Word VBA | 6 | 05-27-2022 01:43 PM |
Replace all Images with ordinal numbers in multiple files | beginner | Word | 0 | 09-19-2021 02:19 AM |
Find and replace header text across multiple files | LG1972 | Excel | 1 | 12-25-2018 04:27 AM |
Macro to Find & Replace Font formats for Multiple Values | GemBox | Word | 6 | 03-12-2018 05:24 AM |