Attribute VB_Name = "udf_dconcat"
'-------------------------------------------------------------------------------
'File         : udf_groupConcat.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/access/functions/group_concat
'Environment  : VBA 2010 +
'Version      : 2.1.0
'Name         : groupConcat
'Author       : Stefan Erb (ERS)
'History      : 00.00.0000 - ERS - Creation
'               ..
'               23.12.2016 - ERS - Fehler behoben. GetString() kannte nicht mit einem leeren Delimiter umgehen
'               31.01.2017 - ERS - Fehler behoben. adClipString war nicht immer bekannt. Ist jetzt eine Konstante
'               03.07.2017 - ERS - GROUP_COCNAT() als @deprecated deklariert, replace() durch RegEx.replace() ersetzt
'-------------------------------------------------------------------------------
Option Explicit

'/**
' * Simuliert ein GROUP_CONCAT()
' * http://blogannath.blogspot.ch/2011/01/microsoft-access-tips-tricks-flattening_28.html
' * String = DConcat(expr, domain [,criteria [,Delimiter [,OrderBy [,Distinct]]]])
' * @param  String      Feld das zusammnegeführt werden soll
' * @param  String      Quelle (Tabelle, View)
' * @param  String      Where-Bedinung ohne WHERE
' * @param  String      Delimiter
' * @param  String      Order By Bedinung. Wenn nichts angegebn ist, wird nach iExpr aufsteigend sortiert
' * @param  Boolean     Werte als DISTINCT behandeln
' * @return String
' */
Public Function DConcat( _
    ByVal iExpr As String, _
    ByVal iDomain As String, _
    Optional ByVal iCriteria As Variant = Null, _
    Optional ByVal iDelimiter As String = ", ", _
    Optional ByVal iOrderBy As Variant = Null, _
    Optional ByVal iDistinct As Boolean = True _
) As String
    Const C_EMPTY_DELIMITER = "\u0020"  'Ersatz Delimiter für GetString
    Const C_EMPTY_DELIMITER_PATTERN = "\\u0020"
On Error GoTo Err_Handler

    'Create SQL String
    Dim sql As String: sql = "SELECT " & IIf(iDistinct, "DISTINCT ", "") & iExpr & " AS item FROM " & iDomain
    If Not IsNull(iCriteria) Then sql = sql & " WHERE " & CStr(iCriteria)
    sql = sql & " ORDER BY " & NZ(iOrderBy, iExpr & " ASC")
    
    'Handle Empty Delimiter. GetString() kann ncith mit einem Leeren Delimiter umgehen.
    Dim delimiter As String: delimiter = IIf(iDelimiter = Empty, C_EMPTY_DELIMITER, iDelimiter)
    'Get the Delimited String
    DConcat = CurrentProject.connection.execute(sql).GetString(, , , delimiter)
    
    'Remove the Delimiter at the End of the String: '1000, 1144, 3000, ' -> '1000, 1144, 3000'
    If DConcat Like "*" & delimiter Then DConcat = Left(DConcat, Len(DConcat) - Len(delimiter))
    'Wennd er Delimiter leer ist, den Ersatz entfernen
    If iDelimiter = Empty Then
        Static rx As Object: If rx Is Nothing Then Set rx = CreateObject("VBScript.RegExp"): rx.pattern = C_EMPTY_DELIMITER_PATTERN: rx.Global = True
        DConcat = rx.Replace(DConcat, "")
        'DConcat = Replace(DConcat, C_EMPTY_DELIMITER, iDelimiter)
    End If
    
Exit_Handler:
On Error Resume Next
    Exit Function
Err_Handler:
    DConcat = "#ERR: " & Err.DESCRIPTION & " (" & sql & ")"
    Resume Exit_Handler
    Resume
End Function

'/**
' * @deprecated
' * Alias zu DConcat(). Ist noch vorhanden, da ich alte Projekte mit diesem Namen habe
' * Im Gegensatz zu DConcat() ist iDistinct standardmässig auf False
' */
Public Function groupConcat( _
    ByVal iExpr As String, _
    ByVal iDomain As String, _
    Optional ByVal iCriteria As Variant = Null, _
    Optional ByVal iDelimiter As String = ", ", _
    Optional ByVal iOrderBy As Variant = Null, _
    Optional ByVal iDistinct As Boolean = False _
) As String
    groupConcat = DConcat(iExpr, iDomain, iCriteria, iDelimiter, iOrderBy, iDistinct)
End Function