![]() |
|
#1
|
|||
|
|||
![]()
Hi, I'm looking for a macro that will compare two different word documents and let me know if there's a difference in the number of paragraphs.
For example, we usually have one document in English, and one translated to French. Sometimes when the English gets translated, the translator may skip a section by accident, or they may have combined two paragraphs by accident. We have 250+ documents to go through every year. Currently, we do it manually by having both documents open side by side and look to see that all of the paragraphs in the French correspond to the English. Is this something that can be done through a macro? Any help is appreciated! |
#2
|
|||
|
|||
![]()
Try the code below, which does the following:
Code:
Option Explicit Sub CompareEnglishAndFrenchFiles() ' 03/18/2022 Dim strFolderEnglish As String ' User-input location of English files Dim strFolderFrench As String ' User-input location of French files Dim strNumParasEnglish As String ' String of English file names and paragraph numbers, concatenated; to be split into an array Dim strArrayEnglishParas() As String ' Array for number of paragraphs in English files Dim strNumParasFrench As String ' String of French file names and paragraph numbers, concatenated; to be split into an array Dim strArrayFrenchParas() As String ' Array for number of paragraphs in French files Dim i As Long ' For comparing English and French versions ' Get location of English files: MsgBox "Click OK, then choose the folder containing the English versions." strFolderEnglish = fcnGetFolderFromPicker(strFolderEnglish) ' Get location of French files: MsgBox "Click OK, then choose the folder containing the French versions." strFolderFrench = fcnGetFolderFromPicker(strFolderFrench) ' Loop through English files and get file name and paragraph totals: strNumParasEnglish = fcnGetNumParasInAllWordFilesInFolder(strFolderEnglish) ' Split string of English file names and paragraph totals and populate array: strArrayEnglishParas = Split(strNumParasEnglish, ",") ' Loop through French files and get file name and paragraph totals: strNumParasFrench = fcnGetNumParasInAllWordFilesInFolder(strFolderFrench) ' Split string of French file names and paragraph totals and populate array: strArrayFrenchParas = Split(strNumParasFrench, ",") ' Compare paragraph totals between pairs of files: For i = LBound(strArrayEnglishParas) To UBound(strArrayEnglishParas) ' If a pair of files has unequal paragraph totals: If Right(strArrayEnglishParas(i), Len(strArrayEnglishParas(i)) - InStr(strArrayEnglishParas(i), "|")) <> _ Right(strArrayFrenchParas(i), Len(strArrayFrenchParas(i)) - InStr(strArrayFrenchParas(i), "|")) Then ' ...then print out info about pairs of files that don't have equal totals: Debug.Print "The following two documents don't have equal paragraph totals: " & vbCr Debug.Print " " & Mid(strArrayEnglishParas(i), 1, InStr(strArrayEnglishParas(i), "|") - 1) Debug.Print " " & Mid(strArrayFrenchParas(i), 1, InStr(strArrayFrenchParas(i), "|") - 1) & vbCr End If Next i End Sub Function fcnGetNumParasInAllWordFilesInFolder(myFolderPath As String) As String ' 03/18/2022 Dim myDocument As Document Dim strPath As String Dim strFile As String Dim strExtension As String Dim strNumParagraphs As String Application.ScreenUpdating = False strPath = myFolderPath strExtension = "*.doc*" ' Target path with file extension: strFile = Dir(strPath & strExtension) ' Loop through each file in the folder: Do While strFile <> "" ' Set variable equal to opened document: Set myDocument = Documents.Open(FileName:=strPath & strFile) If strNumParagraphs = "" Then strNumParagraphs = strFile & "|" & myDocument.Range.Paragraphs.Count Else strNumParagraphs = strNumParagraphs & "," & strFile & "|" & myDocument.Range.Paragraphs.Count End If myDocument.Close SaveChanges:=False ' Get next file name: strFile = Dir Loop fcnGetNumParasInAllWordFilesInFolder = strNumParagraphs ResetSettings: Application.ScreenUpdating = True End Function Function fcnGetFolderFromPicker(myFolderPath As String) As String ' 03/18/2022 Dim strPath As String Dim strFile As String Dim FolderPicker As FileDialog ' Get target folder path from user: Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker) With FolderPicker .Title = "Choose the folder containing your files" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode strPath = .SelectedItems(1) & "\" End With fcnGetFolderFromPicker = strPath NextCode: ' In case the user cancels strPath = strPath End Function |
#3
|
|||
|
|||
![]()
This works perfectly!! Thank you so much!
|
#4
|
|||
|
|||
![]()
You're welcome.docx
Je vous en prie.docx ![]() |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Use VBA to compare Text Box contents between documents. | Downunder Dave | Word VBA | 2 | 07-21-2021 02:16 AM |
Compare 2007 documents with 2010 documents | wardw | Word | 1 | 06-09-2016 02:29 PM |
![]() |
cyraxote | Word VBA | 6 | 10-09-2015 08:03 AM |
compare, match and count cell contents between sheets | bobsone1 | Excel | 11 | 08-07-2014 10:34 PM |
![]() |
admin4ever | Word | 2 | 05-17-2011 09:44 AM |