'---------------------------------------------------------------------------------------
' Procedure : DSUMSTR
' DateTime : 25.12.2011 09:11
' Author : lavrushkin (ДФ)
'---------------------------------------------------------------------------------------
'"Суммирование" строковых значений
Public Function DSUMSTR _
(EXPRESSION As String, Domain As String, Optional WHERECONDITION As String = "", Optional point As String = ";", Optional analis As Boolean = False) As String
DSUMSTR = ""
'EXPRESSION - поле
'DOMAIN - источник данных
'point - разделитель - по умолч ";"
'analis - true - исключать одинаковые, false - все подряд
Dim rst As DAO.Recordset, srez As String
On Error GoTo Er_dsumstr
srez = ""
If Len(WHERECONDITION) > 0 Then
Domain = "[" & Domain & "]." & "[" & EXPRESSION & "] from " & Domain & " WHERE " & "[" & Domain & "]." & WHERECONDITION
End If
Set rst = CurrentDb.OpenRecordset("Select " & Domain & ";")
With rst
If rst.RecordCount > 0 Then
.MoveFirst
While Not .EOF
If analis Then 'исключаем новую строку, если она уже есть в сумме
If InStr(1, Nz(.Fields(EXPRESSION)), srez) = 0 Then
srez = srez & IIf(Nz(.Fields(EXPRESSION), "") = "", "", .Fields(EXPRESSION) & point)
End If
Else
srez = srez & IIf(Nz(.Fields(EXPRESSION), "") = "", "", .Fields(EXPRESSION) & point)
End If
.MoveNext
Wend
End If
End With
Set rst = Nothing
If point <> "" And Len(srez) = 1 Then srez = ""
DSUMSTR = srez
Exit Function
Er_dsumstr:
MsgBox "Ошибка DSUMSTR " & Domain & " " & Err.Number & " (" & Err.Description & ")"
End Function
|