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 |