从excelvba中导入字段总和的任何方法

Question

我在H:\drive中有一个访问数据库，路径在Sheet1单元格H1中给定，我想导入具有相同日期的字段SP的数据总和。表格1的单元格A1中给出了日期。相同的内容将每天与今天/当前日期重复。我能在B1号房得到答案吗。代码构造在Set rs=cn.Execute(strSql(行

Public Sub sum()
Dim cn As Object
Dim rs As Object
Dim strSql As String
Dim strConnection As String
Dim countfrmdb As String
Dim currentdte As Date
currentdte = Sheets("Sheet1").Range("A1")  
dbPath = Sheet1.Range("H1").Value
Set cn = CreateObject("ADODB.Connection")
strConnection = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & dbPath
strSql = "SELECT SUM(SPs) As Total FROM Survey WHERE Date = '" & currentdte & "'"
cn.Open strConnection
Set rs = cn.Execute(strSql)
countfrmdb = rs.Fields(0)
MsgBox (countfrmdb)
End Sub

Answer 1

我在preference&使用了以下代码&就像一个魅力

Sub Importf()

'Declaring the necessary variables.
Dim cnn As Object 'dim the ADO collection class
Dim rs As Object 'dim the ADO recordset class
Dim dbPath As String
Dim SQL As String
Dim i As Integer
Dim var As Range
Dim var1 As Range
'add error handling
On Error GoTo errHandler:
'Disable screen flickering.
Application.ScreenUpdating = False
dbPath = Sheet1.Range("h1").Value
Set var = Sheet1.Range("a1")
Set cnn = New ADODB.Connection

cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
SQL = "SELECT SUM(SPs), sum(Kms) As Total FROM Survey WHERE Date like" & Format(var, "#dd-mmm-yy#")
Set rs = New ADODB.Recordset 'assign memory to the recordset

rs.Open SQL, cnn
'Check if the recordset is empty.
If rs.EOF And rs.BOF Then
'Close the recordet and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'Enable the screen.
Application.ScreenUpdating = True
'In case of an empty recordset display an error.
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If
'Write the reocrdset values in the sheet.
Sheet1.Range("b1").CopyFromRecordset rs
'Close the recordset and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'Update the worksheet
Application.ScreenUpdating = True
'Inform the user that the macro was executed successfully.
MsgBox "Congratulation the data has been successfully Imported", vbInformation, "Data Imported"
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rs = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Import_Data"
End Sub