Привет всем!

Кто в курсе как а Excel можно получить сумму открытой записи
sum.rstTemp!XXX
Не переберая их.

Спасибо.

Sub BalanceALL()

ThisWorkbook.Worksheets("Balance").Cells.Delete

Dim fso, fld, f1, ts, f
Dim Cnxn As ADODB.Connection
Dim strCnxn As String
Dim strSQLAuthors As String
Dim rstTemp As ADODB.Recordset
Set Cnxn = New ADODB.Connection
Set rstTemp = New ADODB.Recordset
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("C:\Program Files\BWMeter\Data")
Set fc = fld.Files



Cnxn.Open "Provider='sqloledb';Data Source='127.0.0.1';Initial Catalog='Home';Integrated Security='SSPI'"

For Each f1 In fc

If Right(f1.Name, 3) = "sts" Then
fname = fso.GetBaseName(f1.Name)


strSQLAuthors = "SELECT DateTime FROM BwMeter WHERE Filter = '" & fname & "'"
rstTemp.CursorLocation = adUseClient
rstTemp.Open strSQLAuthors, Cnxn, adOpenDynamic, adLockOptimistic, adCmdText
rstTemp.Sort = "DateTime"
If rstTemp.EOF Then rstTemp.Close: GoTo 10
rstTemp.MoveFirst
Date_Time = rstTemp!DateTime
rstTemp.Close


Set rstTemp = Nothing
Set rstTemp = New ADODB.Recordset


Do
DoEvents

d0 = DateValue("01." & Format(Date_Time, "mm.yyyy"))
d1 = DateValue(d0 - 1)
d2 = DateValue("01." & Format(d0 + 31, "mm.yyyy"))
d4 = d2
d3 = (DateValue(d2) - 1) + TimeValue("23:30:00")

d1 = Format(d1, "mm.dd.yyyy hh:mm:ss")
d2 = Format(d2, "mm.dd.yyyy hh:mm:ss")





strSQLAuthors = "SELECT Sum(Íà÷èñëåííî) FROM BwMeter WHERE Filter = '" & fname & "' and DateTime> '" & d1 & "' and DateTime< '" & d2 & "'"
rstTemp.Open strSQLAuthors, Cnxn, adOpenDynamic, adLockOptimistic, adCmdText
If rstTemp.EOF Then rstTemp.Close: GoTo 20
SumTemp = rstTemp(0)
rstTemp.Close
Set rstTemp = Nothing
Set rstTemp = New ADODB.Recordset
If SumTemp = 0 Then GoTo 20


strSQLAuthors = "SELECT DateTime,Ñòîèìîñòü,Filter,Date_Time FROM BwMeter WHERE Filter = '" & fname & "' and Date_Time= '" & d3 & "'"
rstTemp.Open strSQLAuthors, Cnxn, adOpenDynamic, adLockOptimistic, adCmdText



If Not rstTemp.EOF Then
rstTemp!Filter = fname
rstTemp!DateTime = d3
rstTemp!Date_Time = d3
s = (SumTemp / 1024 / 1024)
If s > 4000 Then rstTemp!Ñòîèìîñòü = s * 44: GoTo 21
If s > 3000 Then rstTemp!Ñòîèìîñòü = s * 46: GoTo 21
If s > 2500 Then rstTemp!Ñòîèìîñòü = s * 48: GoTo 21
If s > 2000 Then rstTemp!Ñòîèìîñòü = s * 51: GoTo 21
If s > 1500 Then rstTemp!Ñòîèìîñòü = s * 55: GoTo 21
If s > 1000 Then rstTemp!Ñòîèìîñòü = s * 58: GoTo 21
If s > 900 Then rstTemp!Ñòîèìîñòü = s * 60: GoTo 21
If s > 800 Then rstTemp!Ñòîèìîñòü = s * 65: GoTo 21
If s > 600 Then rstTemp!Ñòîèìîñòü = s * 70: GoTo 21
If s > 500 Then rstTemp!Ñòîèìîñòü = s * 75: GoTo 21
If s > 400 Then rstTemp!Ñòîèìîñòü = s * 80: GoTo 21
If s > 300 Then rstTemp!Ñòîèìîñòü = s * 85: GoTo 21
If s > 250 Then rstTemp!Ñòîèìîñòü = s * 90: GoTo 21
If s > 200 Then rstTemp!Ñòîèìîñòü = s * 95: GoTo 21
If s > 150 Then rstTemp!Ñòîèìîñòü = s * 100: GoTo 21
If s > 100 Then rstTemp!Ñòîèìîñòü = s * 110: GoTo 21
If s > 50 Then rstTemp!Ñòîèìîñòü = s * 120: GoTo 21
If s <= 50 Then rstTemp!Ñòîèìîñòü = 6500: GoTo 21



Else
rstTemp.AddNew
rstTemp!DateTime = d3
rstTemp!Date_Time = d3
rstTemp!Filter = fname
s = (SumTemp / 1024 / 1024)
If s > 4000 Then rstTemp!Ñòîèìîñòü = s * 44: GoTo 21
If s > 3000 Then rstTemp!Ñòîèìîñòü = s * 46: GoTo 21
If s > 2500 Then rstTemp!Ñòîèìîñòü = s * 48: GoTo 21
If s > 2000 Then rstTemp!Ñòîèìîñòü = s * 51: GoTo 21
If s > 1500 Then rstTemp!Ñòîèìîñòü = s * 55: GoTo 21
If s > 1000 Then rstTemp!Ñòîèìîñòü = s * 58: GoTo 21
If s > 900 Then rstTemp!Ñòîèìîñòü = s * 60: GoTo 21
If s > 800 Then rstTemp!Ñòîèìîñòü = s * 65: GoTo 21
If s > 600 Then rstTemp!Ñòîèìîñòü = s * 70: GoTo 21
If s > 500 Then rstTemp!Ñòîèìîñòü = s * 75: GoTo 21
If s > 400 Then rstTemp!Ñòîèìîñòü = s * 80: GoTo 21
If s > 300 Then rstTemp!Ñòîèìîñòü = s * 85: GoTo 21
If s > 250 Then rstTemp!Ñòîèìîñòü = s * 90: GoTo 21
If s > 200 Then rstTemp!Ñòîèìîñòü = s * 95: GoTo 21
If s > 150 Then rstTemp!Ñòîèìîñòü = s * 100: GoTo 21
If s > 100 Then rstTemp!Ñòîèìîñòü = s * 110: GoTo 21
If s > 50 Then rstTemp!Ñòîèìîñòü = s * 120: GoTo 21
If s <= 50 Then rstTemp!Ñòîèìîñòü = 6500: GoTo 21

End If
21:

rstTemp.UpdateBatch
rstTemp.Close



20:
Date_Time = d4



If DateValue(d3) > Date Then Exit Do
Loop

If fname = "SQL" Or _
fname = "ADSLStop" Or _
fname = "LAN" Or _
fname = "RDP" Or _
fname = "Denis" Or _
fname = "ADSL" Or _
fname = "Jet" Or _
fname = "diary.ru " Or _
fname = "Icq" Or _
fname = "Internet" Or _
fname = "LanToInternet" Or _
fname = "Mochalo" Or _
fname = "SQLStop" Or _
fname = "diary.ru" Or _
fname = "StopAllInternet" Or _
fname = "StopInternet2" Or _
fname = "Test" Or _
fname = "StopNet" Or _
fname = "StopInternet" _
Then GoTo 10


strSQLAuthors = "SELECT Sum(Îïëà÷åíî-Ñòîèìîñòü) FROM BwMeter WHERE Filter = '" & fname & "'"
rstTemp.Open strSQLAuthors, Cnxn, adOpenDynamic, adLockOptimistic, adCmdText
SumTemp = rstTemp(0)
rstTemp.Close

a = 1
Do While ThisWorkbook.Worksheets("Balance").Cells(a, 1) <> ""
a = a + 1
Loop
ThisWorkbook.Worksheets("Balance").Cells(a, 1) = fname
ThisWorkbook.Worksheets("Balance").Cells(a, 2) = SumTemp
ThisWorkbook.Worksheets("Balance").Cells(a, 3) = Now



10:

End If
Next

ThisWorkbook.Worksheets("Balance").Cells.Sort Key1:=ThisWorkbook.Worksheets("Balance").Cells.Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

ThisWorkbook.Worksheets("Balance").Cells.EntireColumn.AutoFit

End Sub


Private Sub SaveSql1()



Dim fso, fld, f1, ts, f
Dim Cnxn As ADODB.Connection
Dim strCnxn As String
Dim strSQLAuthors As String
Dim rstTemp As ADODB.Recordset
Set Cnxn = New ADODB.Connection
Set rstTemp = New ADODB.Recordset
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder("C:\Program Files\BWMeter\Data")
Set fc = fld.Files



Cnxn.Open "Provider='sqloledb';Data Source='127.0.0.1';Initial Catalog='Home';Integrated Security='SSPI'"

For Each f1 In fc

If Right(f1.Name, 3) = "sts" Then
fname = fso.GetBaseName(f1.Name)


strSQLAuthors = "SELECT DateTime,Íà÷èñëåííî,Ñòîèìîñòü,Îïëà÷åíî FROM BwMeter WHERE Filter = '" & fname & "' and Ñòîèìîñòü!=0"
rstTemp.Open strSQLAuthors, Cnxn, adOpenDynamic, adLockOptimistic, adCmdText
Do While Not rstTemp.EOF
rstTemp!Ñòîèìîñòü = 0
rstTemp.UpdateBatch
rstTemp.MoveNext
Loop
rstTemp.Close

End If

Next


Cnxn.Close

End Sub


Sub BalanceClient()

On Error GoTo 1
Dim Cnxn As ADODB.Connection
Dim strCnxn As String
Dim strSQLAuthors As String
Dim rstTemp As ADODB.Recordset
Set Cnxn = New ADODB.Connection
Set rstTemp = New ADODB.Recordset
User = "Internet"
Pass = "27fd92l1I0"



Cnxn.Open "Provider='sqloledb';Data Source='192.168.111.1';Initial Catalog='Home';;User ID='" & User & "';Password= '" & Pass & "';"
GetUser = ActiveCell
If GetUser = "" Then End
If IsNumeric(GetUser) Then End
If IsDate(GetUser) Then End

strSQLAuthors = "SELECT DateTime,Download,Upload,Íà÷èñëåííî,Ñòîèìîñòü,Îïëà÷åíî FROM BwMeter WHERE Filter = '" & GetUser & "'"
rstTemp.CursorLocation = adUseClient
rstTemp.Open strSQLAuthors, Cnxn, adOpenDynamic, adLockOptimistic, adCmdText
rstTemp.Sort = "DateTime"


If Not rstTemp.EOF Then

ThisWorkbook.Worksheets("Statistik").Cells.ClearContents
ThisWorkbook.Worksheets("Statistik").Cells(1, 7) = GetUser
ThisWorkbook.Worksheets("Statistik").Cells(1, 1) = "DateTime"
ThisWorkbook.Worksheets("Statistik").Cells(1, 2) = "Download"
ThisWorkbook.Worksheets("Statistik").Cells(1, 3) = "Upload"
ThisWorkbook.Worksheets("Statistik").Cells(1, 4) = "Íà÷èñëåííî"
ThisWorkbook.Worksheets("Statistik").Cells(1, 5) = "Ñòîèìîñòü"
ThisWorkbook.Worksheets("Statistik").Cells(1, 6) = "Îïëà÷åíî"
ThisWorkbook.Worksheets("Statistik").Cells(2, 1).CopyFromRecordset rstTemp
ThisWorkbook.Worksheets("Statistik").Columns("A:A").NumberFormat = "dd/mm/yyyy hh:mm:ss"

ThisWorkbook.Worksheets("Statistik").Range("H1").FormulaR1C1 = "=SUM(C[-3])"
ThisWorkbook.Worksheets("Statistik").Range("I1").FormulaR1C1 = "=SUM(C[-3])"
'ThisWorkbook.Worksheets("Statistik").Cells.Sort Key1:=ThisWorkbook.Worksheets("Statistik").Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ThisWorkbook.Worksheets("Statistik").Range("J1").NumberFormat = "[Green]#,##0_ð_.;[Red]-#,##0_ð_."
ThisWorkbook.Worksheets("Statistik").Range("J1").FormulaR1C1 = "=RC[-1]-RC[-2]"
ThisWorkbook.Worksheets("Statistik").Cells.EntireColumn.AutoFit
End If
rstTemp.Close

Worksheets("Statistik").Select

1:

End Sub



Sub BalanceClientAdd()

Dim Cnxn As ADODB.Connection
Dim strCnxn As String
Dim strSQLAuthors As String
Dim rstTemp As ADODB.Recordset
Set Cnxn = New ADODB.Connection
Set rstTemp = New ADODB.Recordset
GetUser = ActiveCell
g = InputBox(GetUser)
If g = 0 Or g = "" Then End
If GetUser = "" Then End
If IsNumeric(GetUser) Then End
If IsDate(GetUser) Then End
Cnxn.Open "Provider='sqloledb';Data Source='127.0.0.1';Initial Catalog='Home';Integrated Security='SSPI'"

strSQLAuthors = "SELECT DateTime,Filter,Date_Time,Îïëà÷åíî FROM BwMeter WHERE Filter = '" & GetUser & "'"
rstTemp.Open strSQLAuthors, Cnxn, adOpenDynamic, adLockOptimistic, adCmdText
s = Format(Now, "dd.mm.yyyy hh:mm:ss")



rstTemp.AddNew
rstTemp!DateTime = s
rstTemp!Date_Time = s
rstTemp!Îïëà÷åíî = g
rstTemp!Filter = GetUser
rstTemp.UpdateBatch

End Sub