Examples |
  
|
Examples |
|
Option Explicit
'---------------------------------------------------------
'Requires a Reference to 'Synkronizer 10.0 Object Library'
'---------------------------------------------------------
Const FILE0 As String = "D:\Documents\TestFile1.xlsx"
Const FILE1 As String = "D:\Documents\TestFile2.xlsx"
Function SynkApplication() As Synkronizer.Application
'Wrapper to retrieve the Application object
With Excel.Application.COMAddIns("Synkronizer.Connect")
'Ensure the addin is connected.
If Not .Connect Then .Connect = True
'Return the application
Set SynkApplication = .Object.Application
End With
'Display progress in Excel's status bar.
SynkApplication.DisplayStatus = True
End Function
Function SynkProject() As Synkronizer.Project
'Wrapper to retrieve the ActiveProject
If Not SynkApplication Is Nothing Then
Set SynkProject = SynkApplication.ActiveProject
End If
End Function
'-----------------------------------------------------------
'Example 1
'Compare sheets "Addresses", highlight differences.
Public Sub Example1()
Dim oProj As Synkronizer.Project
Set oProj = SynkProject
If oProj Is Nothing Then Exit Sub
With oProj
.Files.Load FILE0, FILE1
With .Pairs
.Add "Addresses", "Addresses"
End With
With .Settings
.CompareType = syCompareFormulas
.Formats = 0
.Filters = 0
.HighlightType = syHighlight
.ReportType = syReportNone
.ShowHide = syShowHideENABLED + syHideRowsIden
End With
.ArrangeWindows
.Execute
MsgBox .Results.SummaryMessage, vbOKOnly + vbInformation, "Synkronizer"
.Unload CloseFiles:=True, DisplayUndo:=False
End With
End Sub
'-----------------------------------------------------------
'Example 2
'Compare all sheets, highlight differences.
Public Sub Example2()
Dim oProj As Synkronizer.Project
Set oProj = SynkProject
If oProj Is Nothing Then Exit Sub
With oProj
.Files.Load FILE0, FILE1
With .Pairs
'Ignore empty, hidden or protected sheets
.MatchInclude = 0
.MatchType = syMatchAllByName
.AddMatched
End With
With .Settings
.CompareType = syCompareFormulas
.Formats = 0
'Non-strict: Ignore Case, Whitespace and Type differences
.Filters = syFiltersENABLED + syFiltersCase + syFiltersTrim + syFiltersType
.HighlightType = syHighlightWithReset
.ReportType = syReportNone
.ShowHide = 0
End With
.ArrangeWindows
.Execute
MsgBox .Results.SummaryMessage, vbOKOnly + vbInformation, "Synkronizer"
.Unload CloseFiles:=False, DisplayUndo:=False
End With
End Sub
'-----------------------------------------------------------
'Example 3
'Compare first sheets, create a report
Public Sub Example3()
Dim oProj As Synkronizer.Project
Set oProj = SynkProject
If oProj Is Nothing Then Exit Sub
With oProj
.Files.Load FILE0, FILE1
With .Pairs
.MatchInclude = 0
.MatchType = syMatchFirstByName
.AddMatched
End With
With .Settings
.CompareType = syCompareFormulas
.Formats = 0
.Filters = 0
.HighlightType = syHighlightNone
.ReportType = syReportStandard
.ShowHide = 0
End With
.Execute
.ReportWorkbook.Windows(1).WindowState = xlNormal
MsgBox .Results.SummaryMessage, vbOKOnly + vbInformation, "Synkronizer"
.Unload CloseFiles:=True
End With
End Sub
'-----------------------------------------------------------
'Example 4
'Database comparison, highlight differences
Public Sub Example4()
Dim oProj As Synkronizer.Project
Set oProj = SynkProject
If oProj Is Nothing Then Exit Sub
With oProj
.Files.Load FILE0, FILE1
With .Pairs
.Add "Addresses", "Addresses"
End With
'define database options
With .Pairs(1)
.DBRow = 1
'define primary key columns (of 1st file)
.DBKeys = "2;3"
.DBOptions(syDatabaseGroup) = True
End With
With .Settings
.CompareType = syCompareFormulas
.Formats = 0
.Filters = syFiltersENABLED + syFiltersCase + syFiltersTrim + syFiltersType
.HighlightType = syHighlight
.ReportType = syReportNone
.ShowHide = 0
End With
.ArrangeWindows
.Execute
MsgBox .Results.SummaryMessage, vbOKOnly + vbInformation, "Synkronizer"
.Unload CloseFiles:=True, DisplayUndo:=False
End With
End Sub
'-----------------------------------------------------------
'Example 5
'Compare one "master" file against a series of "updates"
Sub Example5()
Dim oProj As Synkronizer.Project
Dim sFolderNew As String
Dim sFolderRep As String
Dim sFileMaster As String
Dim aFiles() As String
Dim i As Integer
Dim sFile As String
Dim sFileNew As String
Dim sFileRep As String
Dim n(1) As Long
'define master file and folders
'must end with backslash!
sFileMaster = "D:\Documents\Old\Master.xlsx"
sFolderNew = "D:\Documents\New\"
sFolderRep = "D:\Documents\Reports\"
Debug.Assert Len(Dir(sFolderNew, vbDirectory))
Debug.Assert Len(Dir(sFolderRep, vbDirectory))
'read "new" files
i = 1
sFile = Dir(sFolderNew & "*.xls*")
Do While Len(sFile) > 0
ReDim Preserve aFiles(1 To i)
aFiles(i) = sFile
i = i + 1
sFile = Dir
Loop
'loop all files
For i = 1 To UBound(aFiles)
sFileNew = sFolderNew & aFiles(i)
sFileRep = sFolderRep & "Difference Report " & aFiles(i)
sFileRep = Left(sFileRep, InStrRev(sFileRep, ".") - 1) & ".xlsx"
Set oProj = SynkProject
With oProj
With .Settings
.CompareType = syCompareFormulas
.Formats = 0
.Filters = 0
.HighlightType = syHighlightNone
.ShowHide = 0
.ReportType = syReportStandard
End With
.Files.Load sFileMaster, sFileNew
With .Pairs
.MatchInclude = 0
.MatchType = syMatchFirstByName
.AddMatched
End With
.Execute
If .Results.Sum Then
n(1) = n(1) + 1
If Len(Dir(sFileRep)) > 0 Then Kill sFileRep
.ReportWorkbook.Close True, sFileRep
Else
n(0) = n(0) + 1
.ReportWorkbook.Close False
End If
.Unload CloseFiles:=True
End With
Set oProj = Nothing
Next i
MsgBox "finished" & vbLf & _
n(0) & " workbooks without differences" & vbLf & _
n(1) & " workbooks with differences, see reports", _
vbOKOnly + vbInformation, "Synkronizer"
End Sub
'-----------------------------------------------------------
'Example 6
'compare all files with the same names of two folders
'a difference report will be created for each set of files. The differences are highlighted.
Sub Example6()
Dim oProj As Synkronizer.Project
Dim sFile As String
Dim aFiles() As String
Dim i As Integer
Dim sFolderOld As String
Dim sFolderNew As String
Dim sFolderRep As String
Dim sFileOld As String
Dim sFileNew As String
Dim sFileRep As String
Dim sWorkbooks(0 To 1) As String
Dim n(0 To 1) As Long
'define folders
'must end with backslash!
sFolderOld = "D:\Documents\Old\"
sFolderNew = "D:\Documents\New\"
sFolderRep = "D:\Documents\Reports\"
Debug.Assert Len(Dir(sFolderOld, vbDirectory))
Debug.Assert Len(Dir(sFolderNew, vbDirectory))
Debug.Assert Len(Dir(sFolderRep, vbDirectory))
'read "old" files
i = 1
sFile = Dir(sFolderOld & "*.xls*")
Do While Len(sFile) > 0
ReDim Preserve aFiles(1 To i)
aFiles(i) = sFile
i = i + 1
sFile = Dir
Loop
'loop all "old" files
For i = 1 To UBound(aFiles)
sFileOld = sFolderOld & aFiles(i)
sFileNew = sFolderNew & aFiles(i)
sFileRep = sFolderRep & "Difference Report " & aFiles(i)
sFileRep = Left(sFileRep, InStrRev(sFileRep, ".") - 1) & ".xlsx"
'check if "new" is there
If Len(Dir(sFileNew)) > 0 Then
Set oProj = SynkProject
With oProj
With .Settings
.CompareType = syCompareFormulas
.Formats = 0
.Filters = 0
.HighlightType = syHighlight
.ShowHide = 0
.ReportType = syReportStandard
End With
.Files.Load sFileOld, sFileNew
With .Pairs
.MatchInclude = 0
.MatchType = syMatchFirstByName
.AddMatched
End With
.Execute
If .Results.Sum Then
n(1) = n(1) + 1
If Len(Dir(sFileRep)) > 0 Then Kill sFileRep
.ReportWorkbook.Close True, sFileRep
Else
n(0) = n(0) + 1
.ReportWorkbook.Close False
End If
'store workbook names
sWorkbooks(0) = .Files.Workbook(0).Name
sWorkbooks(1) = .Files.Workbook(1).Name
'close project
.Unload CloseFiles:=False
End With
Set oProj = Nothing
'save and close workbooks
With Application
.DisplayAlerts = False
.Workbooks(sWorkbooks(0)).Close SaveChanges:=True
.Workbooks(sWorkbooks(1)).SaveAs sFileNew
.Workbooks(sWorkbooks(0)).Close SaveChanges:=False
.DisplayAlerts = True
End With
End If
Next i
MsgBox "finished" & vbLf & _
n(0) & " workbooks without differences" & vbLf & _
n(1) & " workbooks with differences, see reports", _
vbOKOnly + vbInformation, "Synkronizer"
End Sub
'-----------------------------------------------------------
'Example 7
'compare all files with the same names of two folders
'a log file with the total differences of each file pair will be created
Sub Example7()
Dim oProj As Synkronizer.Project
Dim sFile As String
Dim aFiles() As String
Dim i As Integer
Dim sFolderOld As String
Dim sFolderNew As String
Dim sFolderLog As String
Dim sFileOld As String
Dim sFileNew As String
Dim sFileLog As String
Dim n(1) As Long
Dim t0 As Date
'define folders
'must end with backslash!
sFolderOld = "D:\Documents\Old\"
sFolderNew = "D:\Documents\New\"
sFolderLog = "D:\Documents\Log\"
Debug.Assert Len(Dir(sFolderOld, vbDirectory))
Debug.Assert Len(Dir(sFolderNew, vbDirectory))
Debug.Assert Len(Dir(sFolderLog, vbDirectory))
t0 = Timer
'create log file
sFileLog = sFolderLog & "\synkronizer_log.txt"
Open sFileLog For Output As #1
Print #1, "Synkronizer Logfile"
Print #1, "-------------------"
Print #1, ""
Print #1, "Date: " & Format(Date, "YYYY-MM-DD")
Print #1, "Time: " & Format(Time, "hh:nn:ss")
Print #1, ""
Print #1, "Filepair" & vbTab & "Differences"
'read "old" files
i = 1
sFile = Dir(sFolderOld & "*.xls*")
Do While Len(sFile) > 0
ReDim Preserve aFiles(1 To i)
aFiles(i) = sFile
i = i + 1
sFile = Dir
Loop
'loop all "old" files
For i = 1 To UBound(aFiles)
sFileOld = sFolderOld & aFiles(i)
sFileNew = sFolderNew & aFiles(i)
'check if "new" is there
If Len(Dir(sFileNew)) > 0 Then
Set oProj = SynkProject
With oProj
With .Settings
.CompareType = syCompareFormulas
.Formats = 0
.Filters = 0
.HighlightType = syHighlightNone
.ShowHide = 0
.ReportType = syReportNone
End With
.Files.Load FILE0, FILE1
With .Pairs
.MatchInclude = 0
.MatchType = syMatchFirstByName
.AddMatched
End With
.Execute
Print #1, aFiles(i) & vbTab & .Results.Sum
.Unload CloseFiles:=True
End With
Set oProj = Nothing
Else
Print #1, aFiles(i) & vbTab & "error"
End If
Next i
Print #1, ""
Print #1, "Comparison time: " & Format(Timer - t0, " 00.00\s\")
Close
MsgBox "finished" & vbLf & _
UBound(aFiles) & " files compared, see log file", _
vbOKOnly + vbInformation, "Synkronizer"
End Sub
'-----------------------------------------------------------
'Example 8
'compare all files with the same names of two folders
'does the following:
'1) highlight differences
'2) creates a difference report of each filepair
'3) creates a log file with the total differences of each file pair
Sub Example8()
Dim oProj As Synkronizer.Project
Dim sFile As String
Dim aFiles() As String
Dim i As Integer
Dim sFolderOld As String
Dim sFolderNew As String
Dim sFolderRep As String
Dim sFolderLog As String
Dim sFileOld As String
Dim sFileNew As String
Dim sFileRep As String
Dim sFileLog As String
Dim sWorkbooks(0 To 1) As String
Dim n(0 To 1) As Long
Dim t0 As Date
'define folders
'must end with backslash!
sFolderOld = "D:\Documents\Old\"
sFolderNew = "D:\Documents\New\"
sFolderRep = "D:\Documents\Reports\"
sFolderLog = "D:\Documents\Log\"
Debug.Assert Len(Dir(sFolderOld, vbDirectory))
Debug.Assert Len(Dir(sFolderNew, vbDirectory))
Debug.Assert Len(Dir(sFolderRep, vbDirectory))
Debug.Assert Len(Dir(sFolderLog, vbDirectory))
t0 = Timer
'create log file
sFileLog = sFolderLog & "\synkronizer_log.txt"
Open sFileLog For Output As #1
Print #1, "Synkronizer Logfile"
Print #1, "-------------------"
Print #1, ""
Print #1, "Date: " & Format(Date, "YYYY-MM-DD")
Print #1, "Time: " & Format(Time, "hh:nn:ss")
Print #1, ""
Print #1, "Filepair" & vbTab & "Differences"
'read "old" files
i = 1
sFile = Dir(sFolderOld & "*.xls*")
Do While Len(sFile) > 0
ReDim Preserve aFiles(1 To i)
aFiles(i) = sFile
i = i + 1
sFile = Dir
Loop
'loop all "old" files
For i = 1 To UBound(aFiles)
sFileOld = sFolderOld & aFiles(i)
sFileNew = sFolderNew & aFiles(i)
sFileRep = sFolderRep & "Difference Report " & aFiles(i)
sFileRep = Left(sFileRep, InStrRev(sFileRep, ".") - 1) & ".xlsx"
'check if "new" is there
If Len(Dir(sFileNew)) > 0 Then
Set oProj = SynkProject
With oProj
With .Settings
.CompareType = syCompareFormulas
.Formats = 0
.Filters = 0
.HighlightType = syHighlight
.ShowHide = 0
.ReportType = syReportStandard
End With
.Files.Load sFileOld, sFileNew
With .Pairs
.MatchInclude = 0
.MatchType = syMatchFirstByName
.AddMatched
End With
.Execute
If .Results.Sum Then
n(1) = n(1) + 1
If Len(Dir(sFileRep)) > 0 Then Kill sFileRep
.ReportWorkbook.Close True, sFileRep
Else
n(0) = n(0) + 1
.ReportWorkbook.Close False
End If
Print #1, aFiles(i) & vbTab & .Results.Sum
'store workbook names
sWorkbooks(0) = .Files.Workbook(0).Name
sWorkbooks(1) = .Files.Workbook(1).Name
'close project
.Unload CloseFiles:=False
End With
Set oProj = Nothing
'save and close workbooks
With Application
.DisplayAlerts = False
.Workbooks(sWorkbooks(0)).Close SaveChanges:=True
.Workbooks(sWorkbooks(1)).SaveAs sFileNew
.Workbooks(sWorkbooks(0)).Close SaveChanges:=False
.DisplayAlerts = True
End With
Else
Print #1, aFiles(i) & vbTab & "error"
End If
Next i
Print #1, ""
Print #1, "Comparison time: " & Format(Timer - t0, " 00.00\s\")
Close
MsgBox "finished" & vbLf & _
n(0) & " workbooks without differences" & vbLf & _
n(1) & " workbooks with differences, see reports", _
vbOKOnly + vbInformation, "Synkronizer"
End Sub