FlowFact - Entwicklungstools v19.881 FLOWFACT 2017 R2 - Function - Sql_CrossTable

CrossTable Sql-Anweisung erstellen

Sql-Abfrage über Haupt- und Detailtabelle. Dabei werden die Detailwerte als Spalten zurückgeliefert, als wären diese Bestandteil der Hauptabelle. Beispiel: Tabelle 'Obj' mit den Feldern 'Kennung', 'Intern', 'Headline', 'Miete', 'Kaufpreis', 'Anspechpartner'
Aufruf-Beispiele:
strSql = oDev.oBase.Sql_CrossTable("Obj", "Kennung|Intern|EART", "Headline|Zimmer.Von_Num=Sortierung#BaFl01|Miete.Eingabe=Kürzel|Kaufpreis.von_num|Kaufpreis.bis_num|Alt-/Neubau", "", "Kennung")
strSql = oDev.oBase.Sql_CrossTable("Obj", "Kennung", "Alt-/Neubau.Bezeichnung|Alt-/Neubau.Wert|Alt-/Neubau.FldArtOp_Dsn", "Kennung like '1007'", "Kennung")
strSql = oDev.oBase.Sql_CrossTable("Obj", "Kennung", "Headline|Miete.Eingabe|Kaufpreis.von_num|Kaufpreis.bis_num|Objektart.Bezeichnung|Objektart.Wert|Objektart.FldartOp_Dsn|ZimmerXXX.Von_Num=Sortierung#BaFl01|WohnflächeYYY.von_num=FldArt_DSN#10009987-0844-9002-0028-00001B3B30F6", "Kennung like '%100%'", "Kennung")
strSql = oDev.oBase.Sql_CrossTable("Akt", "Kennung|Erledigt|Subject", "Familienstand|Anzahl_Kinder.von_num|Geburtsdatum", "not (Kürzel='Geburtsdatum' AND von_num=0)", "Kennung")
Set rs = oDev.oBase.FF_GetRecordset(strSql)

WICHTIG:DSN ohne geschweifte Klammern {} übergeben.
Function Sql_CrossTable(ByVal strMainTable As String, ByVal strTblFieldPipeList As String, ByVal strDetailPipeList As String, Optional ByVal strWhere As String = "", Optional ByVal strOrderBy As String = "") As String


strMainTable: Hauptabelle z.B. Obj
strTblFieldPipeList: Durch Pipe '|' getrennte Liste mit Feldern der Hauptabelle z.B. Kennung|Intern
strDetailPipeList: Liste der Feldarten z.B. Headline|Miete.Eingabe|Kaufpreis.von_num|Kaufpreis.bis_num|Objektart.Bezeichnung|Objektart.Wert|Objektart.FldartOp_Dsn|ZimmerXXX.Von_Num=Sortierung#BaFl01|WohnflächeYYY.von_num=FldArt_DSN#10009987-0844-9002-0028-00001B3B30F6
strWhere: Where-Bedingung; für Feldart z.B. Not (Kürzel='Geburtsdatum' AND von_num=0)
strOrderBy: Sortierkriterium WICHTIG: Es können nur Felder aus strTblFieldPipeList verwendet werden z.B. Kennung
Rückgabewert: Sql-Anweisung


Public Function Sql_CrossTable(ByVal strMainTable As String, ByVal strTblFieldPipeList As String, ByVal strDetailPipeList As String, Optional ByVal strWhere As String = "", Optional ByVal strOrderBy As String = "") As String
    Dim strResult As String
    Dim strBuffer As String
    Dim strText As String
    Dim strGroupBy As String
    Dim strSelect As String
    Dim strSelect2 As String
    Dim strWhere2 As String
    Dim strDetFielList As String
    Dim strDetNameField As String
    Dim strDetValueField As String
    Dim p As Long
    Dim strAlias As String
    Dim strFldArtName As String
    Dim strFldArtValue As String

    '** Tabellen - Felder
    strSelect = ""
    strWhere2 = ""
    strBuffer = strTblFieldPipeList
    While strBuffer <> ""
        strText = Trim(m_oTools.StrList_DeleteFirst(strBuffer, "|"))
        If strText <> "" Then
            strSelect = strSelect & ", t1." & strText
        End If
    Wend
    If strSelect <> "" Then
        strSelect2 = Replace(strSelect, ", t1.", ", " & strMainTable & ".")
        strSelect2 = Trim(Mid(strSelect2, 2)) & ", t2.Kürzel, t2.Eingabe, t2.Sortierung, t2.Von_Num, t2.Bis_Num, t2.Typ, t2.Bezeichnung, t2.Wert, t2.FldArt_Dsn, t2.FldArtOp_Dsn "
        strSelect2 = strSelect2 & " FROM §MainTbl§ "
        strSelect2 = strSelect2 & "LEFT OUTER JOIN "
        strSelect2 = strSelect2 & "(SELECT FldArt.Kürzel, FldArt.Sortierung, FldArt.Typ"
        strSelect2 = strSelect2 & ", FldArtOp.Bezeichnung, FldArtOp.Wert"
        strSelect2 = strSelect2 & ", §MainTbl§Det.§MainTbl§_Dsn, §MainTbl§Det.Eingabe, §MainTbl§Det.Von_Num, §MainTbl§Det.Bis_Num, §MainTbl§Det.FldArt_Dsn, §MainTbl§Det.FldArtOp_Dsn "
        strSelect2 = strSelect2 & "FROM §MainTbl§ "
        strSelect2 = strSelect2 & "INNER JOIN §MainTbl§Det ON §MainTbl§.Dsn = §MainTbl§Det.§MainTbl§_Dsn "
        strSelect2 = strSelect2 & "INNER JOIN FldArt ON §MainTbl§Det.FldArt_Dsn = FldArt.Dsn "
        strSelect2 = strSelect2 & "LEFT OUTER JOIN FldArtOp ON §MainTbl§Det.FldArtOp_Dsn = FldArtOp.Dsn "
        strGroupBy = "GROUP BY " & Trim(Mid(strSelect, 2))
    End If


    '** Detail - Felder
    strDetFielList = ""
    strBuffer = strDetailPipeList
    While strBuffer <> ""
        strText = Trim(m_oTools.StrList_DeleteFirst(strBuffer, "|"))
        If strText <> "" Then

            '** DetNameField
            p = InStr(strText, "=")
            If p > 0 Then
                strDetNameField = Mid(strText, p + 1)
                strFldArtName = Mid(strText, 1, p - 1)
            Else
                strDetNameField = "Kürzel"
                strFldArtName = strText
            End If

            '** DetValueField
            p = InStr(strFldArtName, ".")
            If p > 0 Then
                strDetValueField = Mid(strFldArtName, p + 1)
                strFldArtName = Mid(strFldArtName, 1, p - 1)
            Else
                strDetValueField = "Eingabe"
            End If

            '** FeldartName
            p = InStr(strDetNameField, "#")
            If p > 0 Then
                strFldArtValue = Mid(strDetNameField, p + 1)
                strDetNameField = Mid(strDetNameField, 1, p - 1)
            Else
                strFldArtValue = strFldArtName
            End If



            '** Alias
            If UCase(strDetValueField) <> "EINGABE" Then
                strAlias = strFldArtName & "_" & strDetValueField
            Else
                strAlias = strFldArtName
            End If

            '** Select, Where2
            strSelect = strSelect & ", MAX (CASE " & strDetNameField & " "
            strSelect = strSelect & "WHEN '" & strFldArtValue & "' "
            If UCase(strDetValueField) = "DSN" Or UCase(Right(strDetValueField, 4)) = "_DSN" Then
                strSelect = strSelect & "THEN CAST(" & strDetValueField & " AS CHAR(36)) "
            Else
                strSelect = strSelect & "THEN " & strDetValueField & " "
            End If
            strSelect = strSelect & "END ) AS '" & strAlias & "'"

            If InStr(strDetFielList & "|", "|" & strFldArtValue & "|") = 0 Then
                strDetFielList = strDetFielList & "|" & strFldArtValue
                If UCase(strDetNameField) = "FLDART_DSN" Then
                    strWhere2 = strWhere2 & "OR " & strMainTable & "Det." & strDetNameField
                Else
                    strWhere2 = strWhere2 & "OR FldArt." & strDetNameField
                End If
                strWhere2 = strWhere2 & "='" & strFldArtValue & "' "
            End If
        End If
    Wend
    If strSelect <> "" Then
        strSelect = Mid(strSelect, 3)
    End If
    If strWhere2 = "" Then
        Err.Raise vbObjectError, , "Keine Feldart in strDetailPipeList angegeben"
    End If
    strWhere2 = Trim(Mid(strWhere2, 3))
    strSelect2 = strSelect2 & "WHERE (" & strWhere2 & ") "
    strSelect2 = strSelect2 & ") AS t2 on §MainTbl§.Dsn = t2.§MainTbl§_dsn "
    strSelect2 = Replace(strSelect2, "§MainTbl§", strMainTable)

    '** Bsp
    'SELECT t1.dsn, t1.Kennung , t1.Stichwort1, t1.Stichwort2, t1.obj_dsn,
    '
    ' MAX (CASE KÜRZEL WHEN 'Name_LIS_Bew' THEN EINGABE  END ) AS 'Name_LIS_Bew',
    ' MAX (CASE KÜRZEL WHEN 'Name_V_Bearbeiter' THEN EINGABE  END ) AS 'Name_V_Bearbeiter'
    '
    ' from (SELECT AKT.dsn as dsn, AKT.kennung , AKT.Stichwort1, AKT.Stichwort2, akt.obj_dsn, t2.KÜRZEL, t2.EINGABE, t2.VON_NUM, t2.TYP
    '     FROM  AKT LEFT OUTER JOIN (select fldart.kürzel, fldart.sortierung, fldart.dsn, aktdet.akt_dsn, aktdet.eingabe, aktDet.von_num, fldart.typ from aktDet INNER JOIN FLDART ON aktDet.Fldart_Dsn = FLDART.DSN
    '  WHERE (
    ' FLDART.KÜRZEL = 'Name_LIS_Bew' or
    ' FLDART.KÜRZEL = 'Name_V_Bearbeiter')
    ') AS t2 on akt.dsn = t2.akt_dsn where (1=1 and akt.kennung like 'B%') ) AS t1
    'GROUP BY t1.DSN, T1.Kennung , t1.Stichwort1,  t1.Stichwort2, t1.obj_dsn

    '** Result
    strResult = "SELECT " & Trim(strSelect) & " FROM Version , "
    strResult = strResult & " (SELECT " & strSelect2
    If strWhere <> "" Then
        strResult = strResult & "WHERE (" & strWhere & ") "
    End If
    strResult = strResult & ") AS t1 "
    strResult = strResult & strGroupBy & " "
    If strOrderBy <> "" Then
        strResult = strResult & "ORDER BY " & strOrderBy & " "
    End If

    Sql_CrossTable = strResult
End Function