【VBA研究】如何将Excel工作表的内容更新到数据库

iamlaosong文

利用Excel维护数据库，自然就需要完成工作表内容和数据库表内容的互动。将数据库表的内容读到工作表中，这儿就不说了，本文主要是要说一下如何将工作表中修改后的内容更新到数据库表中。

比较快速的方法是采用记录集更新方法，这种方法比较快，也很方便。经测试，对access数据库是没有问题的，微软的SQL Server没测过，不过是一家产品，估计没问题，代码如下：

  1. Sub SaveData_rst()
  2. 'On Error GoTo ErrMsg:
  3. Dim cnn As ADODB.Connection
  4. Dim rst As ADODB.Recordset
  5. Dim sqls, mytable As String
  6. Dim i, j, n As Integer
  7. '建立连接,当前文件的路径可以用ThisWorkbook.Path
  8. Set cnn = New ADODB.Connection
  9. cnn.Open 'Provider =Microsoft.ACE.OLEDB.12.0; Data Source = ' & ThisWorkbook.Path & '\支付宝.accdb'
  10. mytable = '账号明细'
  11. n = Range('a1').End(xlDown).Row '当前工作表有效行数
  12. '使用SQL语句操作数据库
  13. For i = 2 To n
  14. sqls = 'select * from ' & mytable & ' where khzh='' & Cells(i, 1).Value & '''
  15. Set rst = New ADODB.Recordset
  16. '用记录集对象执行SQL语句
  17. rst.Open sqls, cnn, adOpenKeyset, adLockOptimistic
  18. If rst.RecordCount = 0 Then rst.AddNew '找不到，增加一条空记录
  19. For j = 1 To rst.Fields.Count
  20. rst.Fields(j - 1) = Cells(i, j).Value
  21. Next j
  22. rst.Update
  23. Next i
  24. rst.Close ' 关闭记录集
  25. Set rst = Nothing ' 释放对象
  26. cnn.Close ' 关闭连接
  27. Set cnn = Nothing ' 释放对象
  28. MsgBox '操作成功！'
  29. End Sub

现在的问题是我用的不是access而是Oracle，上面的方法不能使用，连接Oracle数据库后，参数adOpenKeyset, adLockOptimistic是空值，用此参数会报错，即使用实值1、3（那两个参数的实际值）替换不报错，可以更新记录集依然不行，提示VBA不支持记录集动态更新。

既然此路不通，只好采取原始的办法，用SQL语句直接完成，实际应用的代码如下：

  1. '将工作表数据保存到数据库
  2. Sub SaveData(opName As String)
  3. Dim row1, k, KeyNum, FieldNo, MaxRow, UpdateNo, InsertNo As Integer
  4. Dim stName, tbName, KeyField, AllFields As String
  5. Dim MyRecord(50)
  6. On Error GoTo ErrMsg:
  7. If opName = 'ZHMX' Then
  8. stName = '账号明细'
  9. tbName = 'EMSAPP_ZFB_ZHMX'
  10. KeyNum = 1 '关键字列号
  11. KeyField = 'khzh'
  12. AllFields = '(khzh,dwmc,bmmc,khmc,mark)'
  13. FieldNo = 5
  14. Else
  15. Exit Sub
  16. End If
  17. OraOpen = OracleOpen() '成功执行后，数据库即被打开
  18. If OraOpen Then
  19. UpdateNo = 0
  20. InsertNo = 0
  21. With Sheets(stName)
  22. MaxRow = .[A65536].End(xlUp).Row
  23. '开始保存
  24. For row1 = 2 To MaxRow
  25. For k = 1 To FieldNo
  26. MyRecord(k) = .Cells(row1, k)
  27. Next k
  28. sqls = 'select count(*) from ' & tbName & ' where ' & KeyField & ' = '' & MyRecord(KeyNum) & '''
  29. Set rst = cnn.Execute(sqls)
  30. Recno = rst(0)
  31. If Recno > 0 Then
  32. sqls = 'update ' & tbName & ' set ' & AllFields & ' = (select ''
  33. For k = 1 To FieldNo - 1
  34. sqls = sqls & MyRecord(k) & '',''
  35. Next k
  36. sqls = sqls & MyRecord(k) & '' from dual) where ' & KeyField & ' = '' & MyRecord(KeyNum) & '''
  37. UpdateNo = UpdateNo + 1
  38. .Cells(row1, FieldNo + 1) = '更新OK'
  39. Else
  40. '插入数据
  41. sqls = 'insert into ' & tbName & AllFields & ' values (''
  42. For k = 1 To FieldNo - 1
  43. sqls = sqls & MyRecord(k) & '',''
  44. Next k
  45. sqls = sqls & MyRecord(k) & '') '
  46. InsertNo = InsertNo + 1
  47. .Cells(row1, FieldNo + 1) = '新增OK'
  48. End If
  49. Set rst = cnn.Execute(sqls)
  50. Next row1
  51. End With
  52. End If
  53. '保存日志msg
  54. Msg = '成功保存至数据库，其中更新：' & UpdateNo & '，新增：' & InsertNo
  55. Prog_Log (opName) '日志
  56. OracleClose '关闭连接
  57. Msg = MsgBox(Msg, vbOKOnly, 'iamlaosong')
  58. Exit Sub
  59. ErrMsg:
  60. MsgBox sqls, vbCritical, '操作失败 ，请检查！'
  61. End Sub


增加一个参数opName的目的是让这个过程可以保存多个表。生成更新的SQL语句采用的格式是“update set (字段1，字段2...) =(select '值1’，'值2'... from dual) where 条件”这种格式，主要是方便写代码。所有的值都用单引号括起来是没有问题的，即使是数值也不影响，不过日期型是不行的，需要另外处理。

Oracle连接开关函数和过程代码如下：

  1. '连接数据库
  2. Function OracleOpen() As Boolean
  3. On Error GoTo ErrMsg:
  4. Set cnn = CreateObject('ADODB.Connection')
  5. Set rst = CreateObject('ADODB.Recordset')
  6. cnnstr = 'Provider=msdaora;Data Source=dl580;User Id=emssxjk;Password=emssxjk;'
  7. cnn.Open cnnstr
  8. OracleOpen = True '成功执行后，数据库即被打开
  9. Exit Function
  10. ErrMsg:
  11. OracleOpen = False
  12. End Function
  13. '关闭连接
  14. Public Sub OracleClose()
  15. If rst.State = adStateOpen Then rst.Close
  16. Set rst = Nothing
  17. If cnn.State = adStateOpen Then cnn.Close
  18. Set cnn = Nothing
  19. End Sub

最后，把读取数据到工作表中的过程列一下：

  1. Public Sub GetData(opName As String)
  2. '根据工作表中的查询语句读取数据
  3. On Error GoTo ErrMsg:
  4. Dim stName, sqls As String
  5. Dim MaxRow As Integer
  6. Dim OraOpen As Boolean
  7. If opName = 'ZHMX' Then
  8. stName = '账号明细'
  9. sqls = 'select khzh,dwmc,bmmc,khmc,mark from EMSAPP_ZFB_ZHMX'
  10. sqls = sqls & ' order by dwmc,bmmc,khzh'
  11. ElseIf opName = 'JYMX' Then
  12. stName = '交易明细'
  13. 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'
  14. sqls = sqls & ' where a.jyrq between to_date('' & Sheets(stName).Range('M3') & '','yyyy-mm-dd') and to_date(''
  15. sqls = sqls & Sheets(stName).Range('N3') & '','yyyy-mm-dd') and a.khzh=b.khzh(+) order by dwmc,bmmc,khzh'
  16. Else
  17. Exit Sub
  18. End If
  19. OraOpen = OracleOpen() '成功执行后，数据库即被打开
  20. If OraOpen Then
  21. Set rst = cnn.Execute(sqls)
  22. sqls = 'CopyFromRecordset'
  23. MaxRow = Sheets(stName).UsedRange.Rows.Count
  24. If MaxRow > 1 Then Sheets(stName).Range('A2:L' & MaxRow).ClearContents
  25. Sheets(stName).Range('A2').CopyFromRecordset rst
  26. OracleClose
  27. Exit Sub
  28. End If
  29. ErrMsg:
  30. MsgBox Err.Description, vbCritical, '操作失败 ，请检查！'
  31. MsgBox sqls, vbCritical, '错误语句'
  32. End Sub

赞 (0)

相关推荐