VBA研究如何将Excel工作表的内容更新到数据库
Posted 宋哥
tags:
篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了VBA研究如何将Excel工作表的内容更新到数据库相关的知识,希望对你有一定的参考价值。
iamlaosong文
利用Excel维护数据库,自然就需要完成工作表内容和数据库表内容的互动。将数据库表的内容读到工作表中,这儿就不说了,本文主要是要说一下如何将工作表中修改后的内容更新到数据库表中。
比较快速的方法是采用记录集更新方法,这种方法比较快,也很方便。经测试,对access数据库是没有问题的,微软的SQL Server没测过,不过是一家产品,估计没问题,代码如下:
Sub SaveData_rst()
'On Error GoTo ErrMsg:
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sqls, mytable As String
Dim i, j, n As Integer
'建立连接,当前文件的路径可以用ThisWorkbook.Path
Set cnn = New ADODB.Connection
cnn.Open "Provider =Microsoft.ACE.OLEDB.12.0; Data Source = " & ThisWorkbook.Path & "\\支付宝.accdb"
mytable = "账号明细"
n = Range("a1").End(xlDown).Row '当前工作表有效行数
'使用SQL语句操作数据库
For i = 2 To n
sqls = "select * from " & mytable & " where khzh='" & Cells(i, 1).Value & "'"
Set rst = New ADODB.Recordset
'用记录集对象执行SQL语句
rst.Open sqls, cnn, adOpenKeyset, adLockOptimistic
If rst.RecordCount = 0 Then rst.AddNew '找不到,增加一条空记录
For j = 1 To rst.Fields.Count
rst.Fields(j - 1) = Cells(i, j).Value
Next j
rst.Update
Next i
rst.Close ' 关闭记录集
Set rst = Nothing ' 释放对象
cnn.Close ' 关闭连接
Set cnn = Nothing ' 释放对象
MsgBox "操作成功!"
End Sub
现在的问题是我用的不是access而是Oracle,上面的方法不能使用,连接Oracle数据库后,参数adOpenKeyset, adLockOptimistic是空值,用此参数会报错,即使用实值1、3(那两个参数的实际值)替换不报错,可以更新记录集依然不行,提示VBA不支持记录集动态更新。
既然此路不通,只好采取原始的办法,用SQL语句直接完成,实际应用的代码如下:
'将工作表数据保存到数据库
Sub SaveData(opName As String)
Dim row1, k, KeyNum, FieldNo, MaxRow, UpdateNo, InsertNo As Integer
Dim stName, tbName, KeyField, AllFields As String
Dim MyRecord(50)
On Error GoTo ErrMsg:
If opName = "ZHMX" Then
stName = "账号明细"
tbName = "EMSAPP_ZFB_ZHMX"
KeyNum = 1 '关键字列号
KeyField = "khzh"
AllFields = "(khzh,dwmc,bmmc,khmc,mark)"
FieldNo = 5
Else
Exit Sub
End If
OraOpen = OracleOpen() '成功执行后,数据库即被打开
If OraOpen Then
UpdateNo = 0
InsertNo = 0
With Sheets(stName)
MaxRow = .[A65536].End(xlUp).Row
'开始保存
For row1 = 2 To MaxRow
For k = 1 To FieldNo
MyRecord(k) = .Cells(row1, k)
Next k
sqls = "select count(*) from " & tbName & " where " & KeyField & " = '" & MyRecord(KeyNum) & "'"
Set rst = cnn.Execute(sqls)
Recno = rst(0)
If Recno > 0 Then
sqls = "update " & tbName & " set " & AllFields & " = (select '"
For k = 1 To FieldNo - 1
sqls = sqls & MyRecord(k) & "','"
Next k
sqls = sqls & MyRecord(k) & "' from dual) where " & KeyField & " = '" & MyRecord(KeyNum) & "'"
UpdateNo = UpdateNo + 1
.Cells(row1, FieldNo + 1) = "更新OK"
Else
'插入数据
sqls = "insert into " & tbName & AllFields & " values ('"
For k = 1 To FieldNo - 1
sqls = sqls & MyRecord(k) & "','"
Next k
sqls = sqls & MyRecord(k) & "') "
InsertNo = InsertNo + 1
.Cells(row1, FieldNo + 1) = "新增OK"
End If
Set rst = cnn.Execute(sqls)
Next row1
End With
End If
'保存日志msg
Msg = "成功保存至数据库,其中更新:" & UpdateNo & ",新增:" & InsertNo
Prog_Log (opName) '日志
OracleClose '关闭连接
Msg = MsgBox(Msg, vbOKOnly, "iamlaosong")
Exit Sub
ErrMsg:
MsgBox sqls, vbCritical, "操作失败 ,请检查!"
End Sub
增加一个参数opName的目的是让这个过程可以保存多个表。生成更新的SQL语句采用的格式是“update set (字段1,字段2...) =(select ‘值1’,'值2'... from dual) where 条件”这种格式,主要是方便写代码。所有的值都用单引号括起来是没有问题的,即使是数值也不影响,不过日期型是不行的,需要另外处理。
Oracle连接开关函数和过程代码如下:
'连接数据库
Function OracleOpen() As Boolean
On Error GoTo ErrMsg:
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
cnnstr = "Provider=msdaora;Data Source=dl580;User Id=emssxjk;Password=emssxjk;"
cnn.Open cnnstr
OracleOpen = True '成功执行后,数据库即被打开
Exit Function
ErrMsg:
OracleOpen = False
End Function
'关闭连接
Public Sub OracleClose()
If rst.State = adStateOpen Then rst.Close
Set rst = Nothing
If cnn.State = adStateOpen Then cnn.Close
Set cnn = Nothing
End Sub
最后,把读取数据到工作表中的过程列一下:
Public Sub GetData(opName As String)
'根据工作表中的查询语句读取数据
On Error GoTo ErrMsg:
Dim stName, sqls As String
Dim MaxRow As Integer
Dim OraOpen As Boolean
If opName = "ZHMX" Then
stName = "账号明细"
sqls = "select khzh,dwmc,bmmc,khmc,mark from EMSAPP_ZFB_ZHMX"
sqls = sqls & " order by dwmc,bmmc,khzh"
ElseIf opName = "JYMX" Then
stName = "交易明细"
sqls = "select a.jyrq,a.ywlsh,a.khzh,a.srje,a.mark,b.dwmc,b.bmmc,b.khmc from EMSAPP_ZFB_JYMX a, EMSAPP_ZFB_ZHMX b"
sqls = sqls & " where a.jyrq between to_date('" & Sheets(stName).Range("M3") & "','yyyy-mm-dd') and to_date('"
sqls = sqls & Sheets(stName).Range("N3") & "','yyyy-mm-dd') and a.khzh=b.khzh(+) order by dwmc,bmmc,khzh"
Else
Exit Sub
End If
OraOpen = OracleOpen() '成功执行后,数据库即被打开
If OraOpen Then
Set rst = cnn.Execute(sqls)
sqls = "CopyFromRecordset"
MaxRow = Sheets(stName).UsedRange.Rows.Count
If MaxRow > 1 Then Sheets(stName).Range("A2:L" & MaxRow).ClearContents
Sheets(stName).Range("A2").CopyFromRecordset rst
OracleClose
Exit Sub
End If
ErrMsg:
MsgBox Err.Description, vbCritical, "操作失败 ,请检查!"
MsgBox sqls, vbCritical, "错误语句"
End Sub
以上是关于VBA研究如何将Excel工作表的内容更新到数据库的主要内容,如果未能解决你的问题,请参考以下文章
如何用VBA把一个工作簿中的工作表内容复制到另一个汇总工作簿里面的指定的工作表里面去?
如何将行从一个 Excel 工作表复制到另一个工作表并使用 VBA 创建重复项?