Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub Command1_Click()
    Dim strTempString  As String
    strTempString = BadConcatString(1000)
    strTempString = BadConcatString(3000)
    strTempString = BadConcatString(5000)
    strTempString = BadConcatString(10000)
    strTempString = BadConcatString(20000)
End Sub
Private Function BadConcatString(lngStringsToConcat As Long) As String
    On Error GoTo Err_Handle
    ' משתנה זמני לשרשור המחרוזת
    Dim strTempString As String
    ' מונה לולאה
    Dim lngCount As Long
    
    ' יצירת Collection שיכיל את האיברים לשרשור
    Dim colTest As Collection
    Set colTest = New Collection
    
    ' מילוי ה - Collection בכמות האיברים שהועברה בפונקציה
    For lngCount = 1 To lngStringsToConcat
        colTest.Add ("OfirConcatTest" & lngCount)
    Next
    
    ' שליפת זמן נוכחי ממערכת ההפעלה - ב - milliSeconds
    Dim dblTickCount As Double
    dblTickCount = GetTickCount
    
    ' השרשור מתבצע בפועל , בעזרת התו השמור - &
    For lngCount = 1 To lngStringsToConcat
        strTempString = strTempString & colTest.Item(lngCount)
    Next
    
    ' הדפסת התוצאה לחלון ה - Immediate ובדיקת זמן ביצוע הפעולה
    Debug.Print "Bad Concat for " & lngStringsToConcat & " Strings took " & GetTickCount - dblTickCount & " ms ."
    ' החזרת המחרוזת המשורשת לפונקציה הקוראת
    BadConcatString = strTempString
    
' קטע קוד שמתבצע תמיד, גם כאשר יש שגיאה - משמש לשחרור אובייקטים
Clean_Up:
    Set colTest = Nothing
Exit Function
Err_Handle:
    MsgBox Err.Number & " : " & Err.Description
    
    GoTo Clean_Up
End Function

Bad Concat for 1000 Strings took 15 ms .
Bad Concat for 3000 Strings took 203 ms .
Bad Concat for 5000 Strings took 1235 ms .
Bad Concat for 10000 Strings took 4937 ms .
Bad Concat for 20000 Strings took 27109 ms .