How can you make a copy of a collection?

[moonmonkey]

Have a look at this very basic function:

Public Function PutFolderContentsInCollection(ByVal strFolder As String, ByRef ColFiles As Collection) As Boolean

On Error GoTo errorhandler

Dim strFileName As String
Dim ColCopyOfOriginal As New Collection

Set ColCopyOfOriginal = ColFiles

strFileName = Dir(strFolder)

Do Until strFileName = ""

ColFiles.Add strFolder & strFileName

strFileName = Dir

Loop

PutFolderContentsInCollection = True

Exit Function

errorhandler:
PutFolderContentsInCollection = False
Set ColFiles = ColCopyOfOriginal
Exit Function

End Function

Basically, before I start adding, I want to make a copy of the original collection, called ColCopyOfOriginal. If the function fails, then the collection ColFiles should get set to ColCopyOfOriginal. However, when I use "Set ColCopyOfOriginal = ColFiles", it seems to LINK the two collections, so when I add to "ColFiles", it adds to "ColCopyOfOriginal" too! Is there a quick way to make a copy of collection "ColFiles" without looping through it all?!

 

[JohnYingling]

Neither ColCopyOfOriginal nor ColFiles is THE collection. Tbey are merely variables that hold a reference (pointer) to A specific collection. The
Set ColCopyOfOriginal = ColFiles
just copies the reference to another variable. Both variables then reference the same collection.

Because you are dealing with strings, it would be easier to use arrays which ARE copied when you assign one to another.
Dim aryFiles() as String
' allocate empty array - aryfiles(0) will not used
ReDim aryFiles(0)
' When accessing th array, start at element 1 (not 0)
...........
Dim aryCopyOfOriginal() As String
aryCopyOfOriginal = aryFiles ' Copy array
strFileName = Dir(strFolder)

K = Ubound(aryFiles) ' K--> last used element
' expand current allocation
Redim Preserve aryFiles(Ubound(aryFiles) + 100)
Do Until strFileName = ""
K = K + 1 ' Use next element
' If too small then reallocate
' Remember, empty elements only cost 4 bytes
If K > Ubound(aryFiles) then Redim aryFiles(1 + 2 * K)
aryFiles(K) = strFolder & strFileName
strFileName = Dir
Loop
Redim Preserve aryFiles(K) ' Resize to actual
' aryfiles(1) is first element. 0=Ubounsd(aryFiles) means empty
PutFolderContentsInCollection = True

Exit Function

errorhandler:
PutFolderContentsInCollection = False
aryFiles = aryCopyOfOriginal
Exit Function

http://www.VBResizer.com

Forms/Controls Resizing/Tabbing Control

http://www.VBCompare.com

Compare Code (Text)

http://www.VBSortGen.com

Generate Sort Class in VB or VBScript

 

[strongm]

We had a thread reasonably recently about object copying, and how it fell into the camp of "sounds simple", but actually wasn't. A quick keyword search should find the thread in question.

 

[JohnYingling]

Ooops
Correction: Change
If K > Ubound(aryFiles) then Redim aryFiles(1 + 2 * K)
to
If K > Ubound(aryFiles) then Redim Preserve aryFiles(1 + 2 * K)

http://www.VBResizer.com

Forms/Controls Resizing/Tabbing Control

http://www.VBCompare.com

Compare Code (Text)

http://www.VBSortGen.com

Generate Sort Class in VB or VBScript