'********************************************************************
'*
'* Sub aryMDResize
'*
'* Author: NetworkAdminKB.com
'* Created: 2009-01-18
'* Modified: 2009-01-25
'*
'* Purpose: Return the given array with the last dimension increased
'* or decressed by numSize. The existing contents of the
'* array will be perserved. Works on one dimensional arrays
'* as well.
'*
'* Input: aryAny = The Multi-Dimensional array to resize.
'* numSize = The number of elements to add.
'* blnVerbose = A Boolean indicating if error messages should
'* be displayed.
'* True = Display Error Messages
'* False = Do NOT Display Error Messages
'*
'* Output: Returns the array with the last dimension increased
'* or decressed by numSize.
'* Return the original variable if the array passed is
'* not actually an array.
'* Returns a single dimension array of numSize if aryAny is Empty
'*
'* Notes: This function adds numSize to the current size of the last
'* dimension in the array.
'* A Dynamic Array is declared as follows
'* Dim aryName
'* ReDim aryName(x,y,....z)
'* Calls:
'* aryDimensions
'*
'* Changes:
'* 2009-01-25: Added support for negative resizes
'********************************************************************
Sub aryMDResize(ByRef aryAny, ByVal numSize, ByVal blnVerbose)
'Version: 1.1 2009-01-25
Dim numUBound, strExecute, numDimensions, strDimensions, x
If IsEmpty(aryAny) Then
If numSize >= 0 Then
ReDim aryAny(numSize)
Else
If blnVerbose Then
Wscript.Echo "aryMDResize", _
"aryAny is Empty, numSize must be greater than zero"
End If 'blnVerbose
End If '
Else
If IsArray(aryAny) Then
numDimensions = aryDimensions(aryAny)
numUBound = UBound(aryAny, numDimensions)
'Build a string of UBounds for each dimension of the array...except last
For x = 1 to numDimensions
Select Case x
Case 1
strDimensions = UBound(aryAny, x)
Case numDimensions
Case Else
strDimensions = strDimensions & "," & UBound(aryAny, x)
End Select 'x
Next 'x
If numSize + numUBound < 0 Then
If blnVerbose Then
Wscript.Echo "aryMDResize", _
"You cannot reduce the size of the array below zero"
End If 'blnVerbose
Exit Sub
End If
If numDimensions = 1 Then
ReDim Preserve aryAny(numUBound + numSize)
Else
strExecute = "ReDim Preserve aryAny(" & strDimensions & "," & numUBound + numSize & ")"
'Wscript.Echo "strExecute: " & strExecute
On Error Resume Next
Execute(strExecute)
If Err.Number > 0 Then
On Error GoTo 0
If blnVerbose Then
Wscript.Echo "aryMDResize", _
"Error: The aryAny parameter passed is not a Dynamic Array."
End If 'blnVerbose
End If 'Err.Number > 0
On Error GoTo 0
End If 'numDimensions = 1
Else
If blnVerbose Then
Wscript.Echo "aryMDResize", _
"Error: The aryAny parameter passed is not an array or an Empty variable."
End If 'blnVerbose
End If 'IsArray(aryAny)
End If 'IsEmpty(aryAny)
End Sub 'aryMDResize