Access2Base - New TempVars collection and TempVar objects

TempVar objects contain variables (name/value pair) that can be dynamically created
and removed by macros.
They're useful to transmit values from one document to another, e.g. an .odb document and one or more non-Base documents.

Change-Id: I2cb5b3e27620eda16bdeaf59788b80c393fe7d9c

1 files changed, 101 insertions, 16 deletions

diff --git a/wizards/source/access2base/Collect.xba b/wizards/source/access2base/Collect.xba
index 34feab0236c3..ebbf6fcc14b3 100644
--- a/wizards/source/access2base/Collect.xba
+++ b/wizards/source/access2base/Collect.xba
@@ -88,7 +88,7 @@ Dim vNames() As Variant, oProperty As Object
 		Case COLLFIELDS
 			Select Case _ParentType
 				Case OBJQUERYDEF
-					Set Item = _ParentDatabase.QueryDefs(_ParentName).Fields(pvItem)	'	<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+					Set Item = _ParentDatabase.QueryDefs(_ParentName).Fields(pvItem)
 				Case OBJRECORDSET
 					Set Item = _ParentDatabase.Recordsets(_ParentName).Fields(pvItem)
 				Case OBJTABLEDEF
@@ -129,10 +129,13 @@ Dim vNames() As Variant, oProperty As Object
 			Set Item = _ParentDatabase.Recordsets(pvItem)
 		Case COLLTABLEDEFS
 			Set Item = _ParentDatabase.TableDefs(pvItem)
+		Case COLLTEMPVARS
+			Set Item = Application.TempVars(pvItem)
 		Case Else
 	End Select
 
 Exit_Function:
+	Utils._ResetCalledSub(cstThisSub)
 	Exit Property
 Error_Function:
 	TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
@@ -170,21 +173,23 @@ REM ----------------------------------------------------------------------------
 REM --- CLASS METHODS	 								        														---
 REM -----------------------------------------------------------------------------------------------------------------------
 
-Public Function Add(Optional pvObject As Variant) As Boolean
-'	Append a new TableDef or Field object to the TableDefs/Fields collections
+Public Function Add(Optional pvNew As Variant, Optional pvValue As Variant) As Boolean
+'	Append a new TableDef or TempVar object to the TableDefs/TempVars collections
 
 Const cstThisSub = "Collection.Add"
 	Utils._SetCalledSub(cstThisSub)
 	If _ErrorHandler() Then On Local Error Goto Error_Function
 	
-Dim odbDatabase As Object, oConnection As Object, oTables As Object, sName As String, oTable As Object
+Dim odbDatabase As Object, oConnection As Object, oTables As Object, oTable As Object
+Dim vObject As Variant, oTempVar As Object
 	Add = False
-	If IsMissing(pvObject) Then Call _TraceArguments()
-	If Not Utils._CheckArgument(pvObject, 1, vbObject) Then Goto Exit_Function
+	If IsMissing(pvNew) Then Call _TraceArguments()
 
-	With pvObject
-		Select Case ._Type
-			Case OBJTABLEDEF
+	Select Case _CollType
+		Case COLLTABLEDEFS
+			If Not Utils._CheckArgument(pvObject, 1, vbObject) Then Goto Exit_Function
+			Set vObject = pvNew
+			With vObject
 				Set odbDatabase = ._ParentDatabase
 				If odbDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
 				Set oConnection = odbDatabase.Connection
@@ -196,11 +201,21 @@ Dim odbDatabase As Object, oConnection As Object, oTables As Object, sName As St
 				Set .TableDescriptor = Nothing
 				.TableFieldsCount = 0
 				.TableKeysCount = 0
-			Case Else
-				Goto Error_NotApplicable
-		End Select
-	End With
+			End With
+		Case COLLTEMPVARS
+			If Not Utils._CheckArgument(pvNew, 1, vbString) Then Goto Exit_Function
+			If pvNew = "" Then Goto Error_Name
+			If IsMissing(pvValue) Then Call _TraceArguments()
+			If Application._hasItem(COLLTEMPVARS, pvNew) Then Goto Error_Name
+			Set oTempVar = New TempVar
+			oTempVar._Name = pvNew
+			oTempVar._Value = pvValue
+			_A2B_.TempVars.Add(oTempVar, UCase(pvNew))
+		Case Else
+			Goto Error_NotApplicable
+	End Select
 
+	_Count = _Count + 1
 	Add = True
 
 Exit_Function:
@@ -213,7 +228,11 @@ Error_NotApplicable:
 	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
 	Goto Exit_Function
 Error_Sequence:
-	TraceError(TRACEFATAL, ERRTABLECREATION, Utils._CalledSub(), 0, 1, pvObject._Name)
+	TraceError(TRACEFATAL, ERRTABLECREATION, Utils._CalledSub(), 0, 1, vObject._Name)
+	Goto Exit_Function
+Error_Name:
+	TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvNew))
+	AddItem = False
 	Goto Exit_Function
 End Function		'	Add	V1.1.0
 
@@ -247,6 +266,7 @@ Dim odbDatabase As Object, oColl As Object, vName As Variant
 			Goto Error_NotApplicable
 	End Select
 
+	_Count = _Count - 1
 	Delete = True
 
 Exit_Function:
@@ -284,6 +304,73 @@ Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
 End Function	'	hasProperty
 
 REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Remove(ByVal Optional pvName As Variant) As Boolean
+'	Remove a TempVar from the TempVars collection
+
+Const cstThisSub = "Collection.Remove"
+	Utils._SetCalledSub(cstThisSub)
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	
+Dim oColl As Object, vName As Variant
+	Remove = False
+	If IsMissing(pvName) Then pvName = ""
+	If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
+	If pvName = "" Then Call _TraceArguments()
+
+	Select Case _CollType
+		Case COLLTEMPVARS
+			If Not _hasItem(COLLTEMPVARS, pvName) Then Goto Error_Name
+			_A2B_.TempVars.Remove(UCase(pvName))
+		Case Else
+			Goto Error_NotApplicable
+	End Select
+
+	_Count = _Count - 1
+	Remove = True
+
+Exit_Function:
+	Utils._ResetCalledSub(cstThisSub)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, cstThisSub, Erl)
+	GoTo Exit_Function
+Error_NotApplicable:
+	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
+	Goto Exit_Function
+Error_Name:
+	TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvName))
+	AddItem = False
+	Goto Exit_Function
+End Function		'	Remove	V1.2.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function RemoveAll() As Boolean
+'	Remove the whole TempVars collection
+
+Const cstThisSub = "Collection.Remove"
+	Utils._SetCalledSub(cstThisSub)
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+
+	Select Case _CollType
+		Case COLLTEMPVARS
+			Set _A2B_.TempVars = New Collection
+			_Count = 0
+		Case Else
+			Goto Error_NotApplicable
+	End Select
+
+Exit_Function:
+	Utils._ResetCalledSub(cstThisSub)
+	Exit Function
+Error_Function:
+	TraceError(TRACEABORT, Err, cstThisSub, Erl)
+	GoTo Exit_Function
+Error_NotApplicable:
+	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
+	Goto Exit_Function
+End Function	'	RemoveAll V1.2.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
 REM --- PRIVATE FUNCTIONS 								        														---
 REM -----------------------------------------------------------------------------------------------------------------------
 Private Function _PropertiesList() As Variant
@@ -320,6 +407,4 @@ Error_Function:
 	_PropertyGet = Nothing
 	GoTo Exit_Function
 End Function		'	_PropertyGet
-
-
 </script:module>
\ No newline at end of file