Execute WinMerge via Excel VBA Tool

Wild Cat - Aug 10 - - Dev Community

Summary

Via this tool, WinMerge compares files in the specified folder including those in subfolders, and outputs the comparison results in HTML format.

The target files are those with the same name in the same folder structure.

How to use

  1. Input setting values in the 'Tool' sheet in the tool.
  2. Push the button on the 'Tool' sheet in the tool.
  3. WinMerge exports the comparison results in HTML format.

Setting

Image description

Source code

Option Explicit

'********************************************************************
'[Summary]
' Via this tool, WinMerge compare files in the specified folder
' including those in subfolders, and output the comparison results
' in HTML format.
' The target files are those with the same name in the same
' folder structure.
'********************************************************************

'Declare a FileSystemObject variable as a module-level variable.
    Dim FSO As Object

'*******************************************************************
'[Summary]
' Main Procedure
' 1.Input Check
' 2.Execute WinMerge via the sub procedure.
'*******************************************************************
Sub ExportWinMergeReport()

    Dim inputFolderPath1 As String 'first comparison target folder
    Dim inputFolderPath2 As String 'secound comparison target folder
    Dim outputFolderPath As String 'destination folder for the reports of WinMerge
    Dim filePathWinMerge As String 'file path of the executable program of WinMerge
    Dim startTime As Date

    startTime = Now

    'Assign setting values to variables
        With ThisWorkbook.Sheets("Tool")
            inputFolderPath1 = .Range("B2").Value
            inputFolderPath2 = .Range("B3").Value
            outputFolderPath = .Range("B4").Value
            filePathWinMerge = .Range("B5").Value
        End With

    'Input Check
        If inputFolderPath1 = "" Then
            MsgBox "The first comparison target folder is not entered in the input field.", vbInformation
            Exit Sub
        End If

        If inputFolderPath2 = "" Then
            MsgBox "The secound comparison target folder is not entered in the input field.", vbInformation
            Exit Sub
        End If

        If outputFolderPath = "" Then
            MsgBox "The output Folder is not entered in the input field.", vbInformation
            Exit Sub
        End If

        If filePathWinMerge = "" Then
            MsgBox "The file path of the executable program of WinMerge is not entered in the input field.", vbInformation
            Exit Sub
        End If

    'Verify if folders and files exist
        Set FSO = CreateObject("Scripting.FileSystemObject")

        If Not FSO.FolderExists(inputFolderPath1) Then
            MsgBox "The first comparison folder doesn't exit.", vbInformation
            Set FSO = Nothing
            Exit Sub
        End If

        If Not FSO.FolderExists(inputFolderPath2) Then
            MsgBox "The secound comparison folder doesn't exit.", vbInformation
            Set FSO = Nothing
            Exit Sub
        End If

        If Not FSO.FileExists(filePathWinMerge) Then
            MsgBox "WinMerge exe file doesn't exist", vbInformation
            Set FSO = Nothing
            Exit Sub
        End If

    'Execute WinMerge
        Call execWinMerge(inputFolderPath1, inputFolderPath2, outputFolderPath, filePathWinMerge)

        Set FSO = Nothing

    'Completion Message
    MsgBox "Completed" & vbLf & "Time " & Format(Now - startTime, "hh:mm:ss"), vbInformation

End Sub

'*******************************************************************
'[Summary]
' Sub procedure to execute WinMerge
'
'[Argument]
' inputFolderPath1 : first comparison target folder
' inputFolderPath2 : secound comparison target folder
' outputFolderPath : destination folder for the reports of WinMerge
' filePathWinMerge : file path of the executable program of WinMerge
'*******************************************************************
Sub execWinMerge(ByVal inputFolderPath1 As String, _
                 ByVal inputFolderPath2 As String, _
                 ByVal outputFolderPath As String, _
                 ByVal filePathWinMerge As String)

    Dim inputFilePath1 As String
    Dim inputFilePath2 As String
    Dim outputFilePath As String
    Dim subFolderPath As String
    Dim exeCode As String
    Dim oFile As Object
    Dim subfolder As Object
    Dim exeStartTime As Date
    Dim canContinue As Boolean
    Dim exeResult As Long

    'Make the folder to export results of WinMerge
    If Not FSO.FolderExists(outputFolderPath) Then
        FSO.CreateFolder (outputFolderPath)
    End If

    'Execute WinMerge
    For Each oFile In FSO.GetFolder(inputFolderPath1).Files

        'Check for the existence of the comparison target file, and if the same file exists, execute WinMerge.
        If FSO.FileExists(inputFolderPath2 & "\" & oFile.Name) Then

            inputFilePath1 = inputFolderPath1 & "\" & oFile.Name
            inputFilePath2 = inputFolderPath2 & "\" & oFile.Name
            outputFilePath = outputFolderPath & "\" & FSO.GetBaseName(oFile) & ".htm"

            exeCode = filePathWinMerge & " " & inputFilePath1 & " " & inputFilePath2 & " /or " & outputFilePath & " /noninteractive /minimize /xq /e /u"
            exeResult = Shell(exeCode, vbMinimizedNoFocus)

            If exeResult = 0 Then
                MsgBox "Failed to execute WinMerge.", vbInformation
                Set FSO = Nothing
                End
            End If

            'Wait for the output of the comparison result. Maximum time is 10 secounds.
                exeStartTime = Now
                canContinue = False

                Do
                    If FSO.FileExists(outputFilePath) Then
                        canContinue = True
                    End If
                Loop Until canContinue Or Now > exeStartTime + TimeSerial(0, 0, 10)

                If Not canContinue Then
                    MsgBox "Failed to output the report of WinMerge." & vbLf & vbLf & outputFilePath, vbInformation
                    Set FSO = Nothing
                    End
                End If

        End If

    Next

    'Execute WinMerge for subfolders as well.
    For Each subfolder In FSO.GetFolder(inputFolderPath1).Subfolders

        'If a subfolder exists, execute recursive processing.
        If subfolder.Name <> "" Then
            subFolderPath = subfolder.Path
            inputFolderPath2 = inputFolderPath2 & "\" & subfolder.Name
            outputFolderPath = outputFolderPath & "\" & subfolder.Name
            Call execWinMerge(subFolderPath, inputFolderPath2, outputFolderPath, filePathWinMerge)
        End If

    Next

End Sub
Enter fullscreen mode Exit fullscreen mode
.
Terabox Video Player