'********************************************************************************************************** ' Name: joinDictionaries ' Author: mielk | 2014-07-15 ' ' Comment: Function to join given dictionaries into a single Dictionary. ' * Function can join up to 30 dictionaries. ' ' Parameters: ' ignoreErrors Parameter of Boolean type. It defines if function should stop working if any error ' occurred and raise an error or if it should just skip the input parameter that ' caused this error and go to the next one. ' dictionaries Dictionaries to be joined. ' This parameter is an array of ParamArray type. It means you can add as many ' dictionaries as you want (up to 30). ' ' ' Returns: ' Dictionary Object of Scripting.Dictionary type containing all the items from the ' dictionaries given to the function in dictionaries array. ' ' ' Exceptions: ' IllegalTypeException Thrown if the parameter passed to this function is not a dictionary. ' KeyAlreadyExistsException Thrown if a key exists in more than one source dictionary. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2014-07-15 mielk Method created. '********************************************************************************************************** Public Function joinDictionaries(ignoreErrors As Boolean, ParamArray dictionaries() As Variant) As Object Const METHOD_NAME As String = "joinDictionaries" '------------------------------------------------------------------------------------------------------ Dim dictResults As Object Dim varDictionary As Variant Dim varKey As Variant '------------------------------------------------------------------------------------------------------ 'Create a new, empty Dictionary for storing results. ------------------------------------------------| Set dictResults = VBA.CreateObject("Scripting.Dictionary") '| '----------------------------------------------------------------------------------------------------| 'Iterate through all the items of dictionaries source array. ----------------------------------------| For Each varDictionary In dictionaries '| '| 'Check if current item is of a dictionary type. ---------------------------------------------| '| If compareString(VBA.TypeName(varDictionary), "dictionary") Then '| '| '| '| 'If current item is of a dictionary type, it is being added to the ------------------| '| '| 'result dictionary. '| '| '| For Each varKey In varDictionary.keys '| '| '| '| '| '| 'Before adding item to the dictionary, it must be checked if there is -------| '| '| '| 'already item with such key. '| '| '| '| 'If there is no such item yet, it is being added to the result dictionary. '| '| '| '| 'If there is already such item, function raise an error and finish working '| '| '| '| 'or just skip this duplicated item (depending on the value of parameter '| '| '| '| '[ignoreErrors]. '| '| '| '| If dictResults.Exists(varKey) Then '| '| '| '| If Not ignoreErrors Then GoTo KeyAlreadyExistsException '| '| '| '| Else '| '| '| '| Call dictResults.add(varKey, varDictionary.item(varKey)) '| '| '| '| End If '| '| '| '| '----------------------------------------------------------------------------| '| '| '| '| '| '| Next varKey '| '| '| '------------------------------------------------------------------------------------| '| '| '| '| Else '| '| '| '| 'If current item is not a dictionary, it is ignored or the function raises '| '| 'IllegalTypeException, depending on the value of parameter ignoreErrors. '| '| If Not ignoreErrors Then GoTo IllegalTypeException '| '| '| '| End If '| '| '--------------------------------------------------------------------------------------------| '| '| Next varDictionary '| '----------------------------------------------------------------------------------------------------| Set joinDictionaries = dictResults '========================================================================================================== ExitPoint: Exit Function '---------------------------------------------------------------------------------------------------------- IllegalTypeException: 'Error handling for the case if any of given parameter is not of Dictionary type. GoTo ExitPoint KeyAlreadyExistsException: 'Error handling for the case if items are duplicated in the input dictionaries. GoTo ExitPoint End Function '********************************************************************************************************** ' Name: compareString ' Author: mielk | 2013-05-15 ' ' Comment: Function compares two strings and returns True if they are equal. ' The difference between this function and function compareStrings is that this ' function can compare only two strings but it is much faster, so it is recommended ' to use this function instead of [compareStrings] if there is no need to compare ' more than two strings to each other. ' ' ' Parameters: ' baseString Base string. ' comparedString String to be compared to the base string. ' isCaseSensitive Optional parameter of Boolean type. ' It defines if comparing is case-sensitive. ' Default value of this parameter is True, that means comparing is case-insensitive. ' trimmed Optional parameter of Boolean type. ' It defines if white spaces at the beginning and at the end of strings should be ' ignored. ' Default value of this parameter is True. ' ' ' Returns ' Boolean True - if both given strings are equal (excluding white spaces if [trimmed] ' parameter is set to True). ' False - if given strings differ from each other or if any of string is null. ' ' ' Exceptions: ' IllegalObjectException Thrown if parameter [baseString] or [comparedString] passed to this ' functions are objects, arrays or other values that cannot be converted ' to String. ' ' ' --- Changes log ----------------------------------------------------------------------------------------- ' 2013-05-15 mielk Method created. '********************************************************************************************************** Public Function compareString(baseString As Variant, comparedString As Variant, _ Optional isCaseSensitive As Boolean = False, Optional trimmed As Boolean = True) As Boolean Const METHOD_NAME As String = "compareString" '------------------------------------------------------------------------------------------------------ Dim compareMethod As VBA.VbCompareMethod Dim base_ As String Dim compared_ As String '------------------------------------------------------------------------------------------------------ 'Fast check if both strings are exactly the same. In such case True is returned without -------------| 'taking any further actions. '| If baseString = comparedString Then GoTo EqualStrings '| '----------------------------------------------------------------------------------------------------| 'Check if any given string is Null. In such case False is returned (even if both strings are null). -| If VBA.isNull(baseString) Or VBA.isNull(comparedString) Then GoTo NullStrings '| '----------------------------------------------------------------------------------------------------| 'Check if both given strings can be converted into Strings. If at least one of them cannot be -------| 'converted, IllegalObjectException is thrown. '| On Error GoTo IllegalObjectException '| base_ = VBA.CStr(baseString) '| compared_ = VBA.CStr(comparedString) '| On Error GoTo 0 '| '----------------------------------------------------------------------------------------------------| 'Convert parameter [isCaseSensitive] of Boolean type to VbCompareMethod type. -----------------------| compareMethod = VBA.IIf(isCaseSensitive, VBA.vbBinaryCompare, VBA.vbTextCompare) '| '----------------------------------------------------------------------------------------------------| 'If the [trimmed] parameter is set to True, remove all white spaces at the beginning and at the -----| 'end of the input strings. '| If trimmed Then '| base_ = VBA.Trim$(base_) '| compared_ = VBA.Trim$(compared_) '| End If '| '----------------------------------------------------------------------------------------------------| 'Check if strings are the same, by using VBA built-in function StrComp. compareString = (VBA.StrComp(base_, compared_, compareMethod) = 0) '========================================================================================================== ExitPoint: Exit Function '---------------------------------------------------------------------------------------------------------- EqualStrings: compareString = True GoTo ExitPoint NullStrings: compareString = False GoTo ExitPoint IllegalObjectException: 'Error handler for the case if objects, arrays or any other values that cannot be converted to 'String have been passed as an input parameters. GoTo ExitPoint End Function