View Single Post
 
Old 03-18-2022, 12:31 AM
Peterson Peterson is offline Windows 10 Office 2019
Competent Performer
 
Join Date: Jan 2017
Posts: 143
Peterson is on a distinguished road
Default

Try the code below, which does the following:
  1. Prompts you to choose a folder with the English versions
  2. Prompts you to choose a folder with the French versions
  3. Gets the file name and number of paragraphs for all files in English and French
  4. Compares the paragraph totals
  5. If a pair of files doesn't have the same number of paragraphs, then in the Immediate window, a message says as much, showing the file names of both versions. (Show the Immediate window via View > Immediate Window, or Ctrl+G.)
Assumptions
  • The English and French folders contain exactly the same set of files, just in their respective languages.
  • Both sets of files are in EXACTLY THE SAME ORDER in both folders.
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
Reply With Quote