Public Function Join01(sArray() As String, Optional Delimiter As String = " ") As String
' by [traditional]
  Dim i As Long
  For i = LBound(sArray) To UBound(sArray) - 1
    Join01 = Join01 & sArray(i) & Delimiter
  Next
  Join01 = Join01 & sArray(UBound(sArray))
End Function

Public Function Join02(sArray() As String, Optional Delimiter As String = " ") As String
' by [traditional, improved]
  Dim i As Long
  For i = LBound(sArray) To UBound(sArray) - 1
    ' add smaller parts first
    Join02 = Join02 & (sArray(i) & Delimiter)
  Next
  Join02 = Join02 & sArray(UBound(sArray))
End Function

Public Function Join03(sArray() As String, Optional Delimiter As String = " ") As String
' by Jody Gelowitz, http://www.visual-statement.com/vb
  Dim r As New CAppendString
  Dim i As Long
  
  For i = LBound(sArray) To UBound(sArray) - 1
    r.AddToString sArray(i) & Delimiter
  Next
  r.AddToString sArray(UBound(sArray))

  Join03 = r.ReturnString

  Set r = Nothing

End Function

' By: Jody Gelowitz
' http://www.visual-statement.com/vb

Option Explicit

Private lPosition As Long
Private strBigString As String
Private lenBBigString As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Friend Sub AddToString(strAdd As String)

'If the current position + length of string to add is greater
'than the length of the BigString, then increase the size of
'the BigString
    If lPosition + LenB(strAdd) > lenBBigString Then
      strBigString = strBigString & Space$(10000)
      lenBBigString = LenB(strBigString)
    End If
'Add strAdd to the BigString
    CopyMemory ByVal StrPtr(strBigString) + lPosition, ByVal StrPtr(strAdd), LenB(strAdd)
'Move the pointer to show where the end of the string is
    lPosition = lPosition + LenB(strAdd)

End Sub

Friend Property Get ReturnString() As String

'Trim off the blank characters and return the string
    strBigString = Left$(strBigString, lPosition \ 2) 'trim back to size
    ReturnString = strBigString
    
End Property

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Public Function Join04(sArray() As String, Optional Delimiter As String = " ") As String
' by Jody Gelowitz, http://www.visual-statement.com/vb
' * rewritten as self-sufficient procedure by Donald (00.0915)
  Dim strBigString As String
  Dim lenBBigString As Long
  Dim lenBDelimiter As Long
  Dim lenBElement As Long
  Dim lPosition As Long
  Dim i As Long
  
  ' len of Delimiter to fast var
  lenBDelimiter = LenB(Delimiter)
  
  For i = LBound(sArray) To UBound(sArray) - 1
    ' len of this element to fast var
    lenBElement = LenB(sArray(i))
    ' If the current position + length of string(s) to add is greater
    ' than the length of the BigString, then increase the size of
    ' the BigString
    If lPosition + lenBElement + lenBDelimiter > lenBBigString Then
      strBigString = strBigString & Space$(10000)
      lenBBigString = LenB(strBigString)
    End If
    ' Add strAdd to the BigString
    CopyMemory ByVal StrPtr(strBigString) + lPosition, ByVal StrPtr(sArray(i)), lenBElement
    ' Add delimiter to the BigString
    If lenBDelimiter Then
      CopyMemory ByVal StrPtr(strBigString) + lPosition + lenBElement, ByVal StrPtr(Delimiter), lenBDelimiter
    End If
    ' Move the pointer to show where the end of the string is
    lPosition = lPosition + lenBElement + lenBDelimiter
  Next
  
  ' Trim off the blank characters, and add last element the old-fashioned way
  Join04 = Left$(strBigString, lPosition \ 2) & sArray(UBound(sArray))

End Function

Public Function Join05(sArray() As String, _
    Optional Delimiter As String = " ") As String

' by G.Beckmann   eMail: G.Beckmann@NikoCity.de
    
    Dim c&, iLen&, iCurPos&, nChars&, iLo&, iHi&, nEmptyStr&
    
    '/ Calculate the size of the new string
    iLo = LBound(sArray)
    iHi = UBound(sArray)
    For c = iHi To iLo Step -1
        nChars = Len(sArray(c))
        iLen = iLen + nChars
        If nChars = 0 Then nEmptyStr = nEmptyStr + 1 Else Exit For
    Next c
    For c = iLo To iHi - nEmptyStr - 1
        iLen = iLen + Len(sArray(c))
    Next c
    
    nChars = Len(Delimiter)
    iLen = iLen + (iHi - iLo) * nChars
    
    '/ Fill the new string
    If iLen Then
        Join05 = Space$(iLen)
        
        Mid$(Join05, 1) = sArray(iLo)
        iCurPos = Len(sArray(iLo)) + 1
        
        If nChars Then
            For c = iLo + 1 To iHi - nEmptyStr
                Mid$(Join05, iCurPos, nChars) = Delimiter
                iCurPos = iCurPos + nChars
            
                Mid$(Join05, iCurPos, iLen) = sArray(c)
                iCurPos = iCurPos + Len(sArray(c))
            Next c
            For c = iCurPos To iLen Step nChars
                Mid$(Join05, c, nChars) = Delimiter
            Next c
        Else
            For c = iLo + 1 To iHi - nEmptyStr
                Mid$(Join05, iCurPos, iLen) = sArray(c)
                iCurPos = iCurPos + Len(sArray(c))
            Next c
        End If
    End If

End Function

Public Function Join06(sArray() As String, _
                     Optional sDelimiter As String = " ") As String
 
   ' by G.Beckmann   eMail: G.Beckmann@NikoCity.de
   ' modified by Keith, kmatzen@ispchannel.com
    
   Dim lNdx      As Long
   Dim lJoinLen  As Long
   Dim lCurPos   As Long
   Dim lDelimLen As Long
   Dim lLo       As Long
   Dim lHi       As Long
   Dim lLastStr  As Long
   
   lLo = LBound(sArray)
   lHi = UBound(sArray)
   lDelimLen = Len(sDelimiter)
   
   '/ Calculate the size of the new string
   lJoinLen = (lHi - lLo) * lDelimLen
   For lNdx = lHi To lLo Step -1
      If Len(sArray(lNdx)) > 0 Then
         lJoinLen = lJoinLen + Len(sArray(lNdx))
         lLastStr = lNdx          'Position of last non-empty string
         Exit For
      End If
   Next lNdx
   For lNdx = lLo To lLastStr - 1
      lJoinLen = lJoinLen + Len(sArray(lNdx))
   Next lNdx
 
   '/ Fill the new string
   If lJoinLen > 0 Then
      Join06 = Space$(lJoinLen)
            
      Mid$(Join06, 1) = sArray(lLo)
      lCurPos = Len(sArray(lLo)) + 1
      If lDelimLen > 0 Then
         For lNdx = lLo + 1 To lLastStr
            Mid$(Join06, lCurPos, lDelimLen) = sDelimiter
            lCurPos = lCurPos + lDelimLen
            
            Mid$(Join06, lCurPos, lJoinLen) = sArray(lNdx)
            lCurPos = lCurPos + Len(sArray(lNdx))
         Next lNdx
         For lNdx = lCurPos To lJoinLen Step lDelimLen
            Mid$(Join06, lNdx, lDelimLen) = sDelimiter
         Next lNdx
      Else
         For lNdx = lLo + 1 To lLastStr
            Mid$(Join06, lCurPos, lJoinLen) = sArray(lNdx)
            lCurPos = lCurPos + Len(sArray(lNdx))
         Next lNdx
      End If
   End If
 
End Function

Public Function Join07(source() As String, Optional _
            sDelim As String = " ") As String
' by Microsoft, http://support.microsoft.com/support/kb/articles/q188/0/07.asp
      Dim sOut As String, iC As Integer
      On Error GoTo errh:
          For iC = LBound(source) To UBound(source) - 1
              sOut = sOut & source(iC) & sDelim
          Next
          sOut = sOut & source(iC)
          Join07 = sOut
          Exit Function
errh:
          Err.Raise Err.Number
End Function

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function SysAllocStringByteLen Lib "oleaut32.dll" _
    (ByVal lpstr As Long, ByVal ByteLen As Long) As Long


Public Function Join08(SourceArray() As String, _
              Optional Delimiter As String = " ", _
        Optional ByVal Count As Long = -1) As String

' by Matt Curland, mattcur@microsoft.com, www.PowerVB.com, 20001001
' [org. name Join7, slight adjustments to our definition by Donald]

' Works with VB- or typelib-declared CopyMemory (pass strings with StrPtr)
    Dim Lower As Long
    Dim Upper As Long
    Dim cbDelim As Long
    Dim cbTotal As Long
    Dim i As Long
    Dim pCurDest As Long
    Dim pDelim As Long
    Dim cbCur As Long
    
    Lower = LBound(SourceArray)
    If Count = -1 Then
        Upper = UBound(SourceArray)
    Else
        Upper = Lower + Count - 1
    End If
    For i = Lower To Upper
        cbTotal = cbTotal + LenB(SourceArray(i))
    Next i
    cbDelim = LenB(Delimiter)
    If cbDelim Then cbTotal = cbTotal + cbDelim * (Upper - Lower)
    
    'Use API to avoid useless initialization
    CopyMemory ByVal VarPtr(Join08), SysAllocStringByteLen(0, cbTotal), 4
    'Use this instead if APIs are typelib-declared:
    ''Join08 = SysAllocStringByteLen(0, cbTotal)
    
    'Now, split into two different paths
    'a) No delimiter
    'b) Delimiter
    pCurDest = StrPtr(Join08)
    If cbDelim = 0 Then
        For i = Lower To Upper
            cbCur = LenB(SourceArray(i))
            CopyMemory ByVal pCurDest, ByVal StrPtr(SourceArray(i)), cbCur
            pCurDest = pCurDest + cbCur
        Next i
    Else
        pDelim = StrPtr(Delimiter)
        For i = Lower To Upper - 1
            cbCur = LenB(SourceArray(i))
            CopyMemory ByVal pCurDest, ByVal StrPtr(SourceArray(i)), cbCur
            pCurDest = pCurDest + cbCur
            CopyMemory ByVal pCurDest, ByVal pDelim, cbDelim
            pCurDest = pCurDest + cbDelim
        Next i
        CopyMemory ByVal pCurDest, ByVal StrPtr(SourceArray(i)), LenB(SourceArray(i))
    End If
End Function

Private Type OwnedInteger
    Owner As ArrayOwner
    pSA() As Integer
End Type
Private m_DerefInteger As OwnedInteger



Public Function Join09(SourceArray() As String, _
              Optional Delimiter As String = " ", _
              Optional ByVal Count As Long = -1) As String
  
' by Matt Curland, mattcur@microsoft.com, www.PowerVB.com, 20001004

'Works with typelib-declared CopyMemory only (no StrPtr protection).
'1-character delimiter optimized using techniques from:
'  Advanced Visual Basic: Power Techniques for Everyday Programs (http://www.PowerVB.com)
'Does not use VBoost.UAdd for incrementing pointers (fastest routine).
  
  Dim Lower As Long
  Dim Upper As Long
  Dim cbDelim As Long
  Dim cbTotal As Long
  Dim i As Long
  Dim pCurDest As Long
  Dim pDelim As Long
  Dim cbCur As Long
  Dim iDelim As Integer
  
  ' project: #Const NOVBOOST = 1
  #If NOVBOOST = 0 Then
  'Call InitVBoost before timing to get accurate results. Needed for ArrayOwner
  If VBoost Is Nothing Then InitVBoost
  #End If
  
  Lower = LBound(SourceArray)
  If Count = -1 Then
      Upper = UBound(SourceArray)
  Else
      Upper = Lower + Count - 1
  End If
  For i = Lower To Upper
      cbTotal = cbTotal + LenB(SourceArray(i))
  Next i
  cbDelim = LenB(Delimiter)
  If cbDelim Then cbTotal = cbTotal + cbDelim * (Upper - Lower)
  
  'Use API to avoid useless initialization
  Join09 = SysAllocStringByteLen(0, cbTotal)
  'Now, split into three different paths
  'a) No delimiter
  'b) One character delimiter
  'c) > One character delimiter
  pCurDest = StrPtr(Join09)
  Select Case cbDelim
      Case 0
          For i = Lower To Upper
              cbCur = LenB(SourceArray(i))
              CopyMemory ByVal pCurDest, ByVal SourceArray(i), cbCur
              pCurDest = pCurDest + cbCur 'VBoost.UAdd(pCurDest, cbCur)
          Next i
      Case 2
          'Use numeric assignment instead of CopyMemory to
          'move the delimiter around
          iDelim = AscW(Delimiter)
          With m_DerefInteger
              If .Owner.SA.cDims = 0 Then InitArrayOwner .Owner, LenB(.pSA(0)), 0
              For i = Lower To Upper - 1
                  cbCur = LenB(SourceArray(i))
                  CopyMemory ByVal pCurDest, ByVal SourceArray(i), cbCur
                  pCurDest = pCurDest + cbCur 'VBoost.UAdd(pCurDest, cbCur)
                  .Owner.SA.pvData = pCurDest
                  .pSA(0) = iDelim
                  pCurDest = pCurDest + 2 'VBoost.UAdd(pCurDest, cbCur)
              Next i
              CopyMemory ByVal pCurDest, ByVal SourceArray(i), LenB(SourceArray(i))
          End With
      Case Else
          pDelim = StrPtr(Delimiter)
          For i = Lower To Upper - 1
              cbCur = LenB(SourceArray(i))
              CopyMemory ByVal pCurDest, ByVal SourceArray(i), cbCur
              pCurDest = pCurDest + cbCur 'VBoost.UAdd(pCurDest, cbCur)
              CopyMemory ByVal pCurDest, ByVal pDelim, cbDelim
              pCurDest = pCurDest + cbDelim 'VBoost.UAdd(pCurDest, cbCur)
          Next i
          CopyMemory ByVal pCurDest, ByVal SourceArray(i), LenB(SourceArray(i))
  End Select
End Function

The code is a bit too long to be displayed here ... download it to have a look.

The code is a bit too long to be displayed here ... download it to have a look.

Public Function Join12(SourceArray As Variant, _
              Optional Delimiter As Variant = " ") As String
    'made by Egbert Nierop at egbert_nierop.nospam@hotmail.com at april 2001, 20020528
    ' remove the spam prevention by robots to email

    ' win95 does not have NTDLL.DLL I think :< but if you have win95,
    '     install a decent windows please :)
    '     or just leave the idemode = True intact
    
    ' warning! Testing with this precompiled switch to False will
    ' crash the VB IDE
    ' in compiled mode however, vb compiles the __cdecl correct by
    '  ADD ESP, -12 whichs means decrement stack pointer by 12 (each pointer is 4 bytes)
    #Const idemode = True
    
    Dim lUbound As Long
    Dim lDelimLen As Long
    
    '  important. The compiled location from these two variables just differ 4 bytes
    ' because they are anyway on the stack
    ' this way I have no TYPE/ struct overhead
    '   so do not place any variables between them!

    Dim lElemLen As Long
    
    Dim lMaxLen As Long
    Dim lOldLen As Long
    Dim lLbound As Long
    Dim sTemp() As String
    
    Dim lTemp As Long
    Dim iVType As Integer
    Dim psaData As Long
    Dim sDelimiter As String
    Dim bFill As Boolean
    Const VT_BYREF = &H4000
    Dim psa As Long
    Dim sPtr As Long


    #If idemode = True Then

        kernel.MoveMemory iVType, SourceArray, 2
        kernel.MoveMemory SourceArray, vbLong, 2
        psa = SourceArray
        kernel.MoveMemory SourceArray, iVType, 2

    #Else

        ntdll.MoveMemory iVType, SourceArray, 2
        ntdll.MoveMemory SourceArray, vbLong, 2
        psa = SourceArray
        ntdll.MoveMemory SourceArray, iVType, 2

    #End If
    
    If iVType And (vbArray Or vbString) = 0 Then Exit Function
    
    ' reindex if the variant parameter was sent by reference
    ' one of the optimizations for oleaut :)
    If iVType And VT_BYREF Then
        #If idemode = True Then
            kernel.MoveMemory psa, ByVal psa, 4
        #Else
            ntdll.MoveMemory psa, ByVal psa, 4
        #End If
    End If
    'dont process non-initialised SafeArrays
    If psa = 0 Then Err.Raise 9

    #If idemode = True Then
        kernel.MoveMemory ByVal ArrayPtr.VarPtrStringArray(sTemp()), psa, 4
    #Else
        ntdll.MoveMemory ByVal ArrayPtr.VarPtrStringArray(sTemp()), psa, 4
    #End If
   
   ' If UBound(sTemp(), 1) <> 1 Then Err.Raise 9
    sDelimiter = Delimiter

    lLbound = OleAut.SafeArrayGetLBound(psa, 1)
    lUbound = OleAut.SafeArrayGetUBound(psa, 1)
    lDelimLen = OleAut.SysStringByteLen(sDelimiter)
    Dim x As Long

    For x = lLbound To lUbound
        lMaxLen = lMaxLen + OleAut.SysStringByteLen(sTemp(x)) + lDelimLen
    Next
    lMaxLen = lMaxLen - lDelimLen
    
    If lUbound - lLbound = 0 Then
        Err.Raise 9
    End If
    
   
    sPtr = OleAut.SysAllocStringByteLenPtr(ByVal 0&, lMaxLen)
    For lLbound = lLbound To lUbound
        lElemLen = OleAut.SysStringByteLen(sTemp(lLbound))
        
        #If idemode = True Then
            
            kernel.MoveMemoryFromStr ByVal sPtr + lOldLen, sTemp(lLbound), lElemLen
            lOldLen = lOldLen + lElemLen
            If lDelimLen Then
                kernel.MoveMemoryFromStr ByVal sPtr + lOldLen, sDelimiter, lDelimLen
                lOldLen = lOldLen + lDelimLen
            End If

        #Else 'compilemode

            ntdll.MoveMemoryFromStr ByVal sPtr + lOldLen, sTemp(lLbound), lElemLen
            lOldLen = lOldLen + lElemLen

            If lDelimLen Then
                ntdll.MoveMemoryFromStr ByVal sPtr + lOldLen, sDelimiter, lDelimLen
                lOldLen = lOldLen + lDelimLen
            End If

        #End If

    Next
    kernel.ZeroMemory ByVal ArrayPtr.VarPtrStringArray(sTemp()), 4
    
    #If idemode = True Then
        kernel.MoveMemory Join12, sPtr, Len(sPtr)
    #Else
        ntdll.MoveMemory Join12, sPtr, Len(sPtr)
    #End If

End Function