我想每天(使用excel)将来自不同部门的多个数据添加到访问数据库中。每个部门将在同一行的特定单元格中添加特定数据的位置(每天一次)。
数据库结构:
time_stamp cpi_qty cpi_value rm_qty rm_value
这是我的代码:
Private Sub cpi_send_data_Click()
'Declaring the necessary variables.
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rs As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim SQL As String
Dim i As Integer
Dim item As String
'add error handling
On Error GoTo errHandler:
'Variables
dbPath = Sheets("Export").Range("I3").Value
'Initialise the collection class variable
Set cnn = New ADODB.Connection
'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
'Create the ADODB recordset object.
Set rs = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '—-5 arguments—-
'Source, ActiveConnection, CursorType, LockType, Options
此代码工作正常,但我只想删除以下部分,如果删除此部分,则会引发错误(找不到对象)。我在哪里犯错?
rs.Open "tbl_bdm", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'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
'MsgBox (rs("Standard").Value)
rs.Close
我想不需要上面的那部分
Dim curr_date As Date
curr_date = Date
'Create the SQL statement to retrieve the data from table.
SQL = "SELECT * FROM tbl_bdm WHERE time_stamp =#" & curr_date & "#" '& Format(curr_date, dd - mm - yyyy)
rs.Open SQL, cnn
'Check if the recordset is empty.
If rs.EOF And rs.BOF Then
'Close the recordset 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"
'rs.Open "tbl_bdm", ActiveConnection:=cnn, _
'CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
'Options:=adCmdTable
With rs
.AddNew
.Fields("time_stamp").Value = Date
'.Fields("Surname").Value = Arec2
End With
rs.Update
'Exit Sub
End If
If rs("time_stamp").Value = Date Then
'SQL = " UPDATE tbl_bdm SET time_stamp = '10-Jul-19' WHERE (((time_stamp)='7/11/2019'));"
rs.Fields("daily_sales_visit").Value = sales_form.TextBox2
rs.Fields("mtd_sales_visit").Value = sales_form.TextBox3
rs.Update
MsgBox "if part working"
'DoCmd.RunSql SQL
Else
With rs
.AddNew
.Fields("time_stamp").Value = Date
'.Fields("Surname").Value = Arec2
End With
rs.Update
MsgBox "else part working"
End If
'MsgBox (result_data)
'Write the reocrdset values in the sheet.
'Sheet2.Range("a2").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
'sales_form WILL BE CLOSED
'Unload Me
Exit Sub
errHandler:
'Clear memory
Set rs = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Import_Data"
End Sub
我是Access VBA的新手,所以请在代码中添加其他注释。 我尝试使用UPDATE查询直接更新数据库,但是出现不允许更新错误。 经过大量的尝试和尝试,这部分似乎可以正常工作。 谢谢