|
|
本帖最后由 ︶ㄣ寒冰 于 2018-5-24 00:37 编辑
之前以为这个代码可以批量的完成数据库更新和插入功能，实际上最近才发现这个插入只能一次性的，很是头痛！解决方法和代码见4楼
问题：
1.数据库中没有记录时，第一次运行Excel表中的代码，可以将表格中现有记录全部插入数据库；之后再运行代码，无法将表中新增记录插入数据库。
2.当修改Excel表格中发货情况时，如有相同订单号时，只有修改对应订单号最后一条记录时，才会更新，且会将最后一条记录前相同订单号的数据都更新。
需求：
1.在不删除Access数据库中原有记录的前提下，在Excel表格中增加记录后，运行代码可将新增记录插入数据库中；
2.当修改Excel表格中某条生产记录发货状态后，通过Excel记录中“生产订单号”和“产品型号”对数据中的对应记录进行更新；
最后,如果有办法解决，还请对原代码的问题加以说明，谢谢！
- Public Datapath, DataName, DataTable, act As String, Error%
- Public cnn As ADODB.Connection, rs As ADODB.Recordset
- Sub Init()
- '设置服务器地址、数据库名称及数据表名称
- Datapath = ThisWorkbook.Path & "" '"\\192.168.1.88\Database" '数据库地址
- DataName = "production_database.mdb" ' "数据库名称"
- DataTable = "Order_information" ' "查询数据库中数据表名"
- act = Split(Split(ActiveWorkbook.Name, "_")(1), ".")(0) & "[ DISCUZ_CODE_0 ]quot;
-
- '设置数据库连接并测试连接是否正常
- On Error Resume Next
- Set cnn = New ADODB.Connection
- cnn.Open "Provider=Microsoft.ace.OLEDB.12.0;jet oledb:database password = vadsys;Data Source=" & Datapath & DataName '连接数据库
- If Err.Number Then
- 'MsgBox Err.Description, , "错误提示"
- MsgBox "请确认数据路径或名称是否正确！", , "错误提示"
- Else
- On Error GoTo 0
- If cnn.State <> 1 Then
- MsgBox "连接数据库失败，请检查网络连接！", , "连接失败"
- cnn.Close
- Set cnn = Nothing
- End If
- End If
- End Sub
- Sub Uploading_data()
- Application.ScreenUpdating = False
- 'ActiveSheet.Unprotect Password:="vadsys" '撤消工作表保护
- Dim Target As String
- Dim i As Integer
- Call Init
-
- For i = 1 To Sheets.Count
- If Sheets(i).Name = Split(act, "[ DISCUZ_CODE_0 ]quot;)(0) Then
- With Sheets(i)
- .Activate
- '生成更新字符串，如：a.姓名=b.姓名,a.性别=b.性别,……
- arrFields = .Range("A1:X1") '工作表中的字段名写入数组
- For Z = 2 To UBound(arrFields, 2) '生成更新字符串
- StrTemp = StrTemp & ",a." & arrFields(1, Z) & "=b." & arrFields(1, Z)
- Next
- '生成更新区域
- x = .Cells(Rows.Count, 1).End(xlUp).Row '检查A列行数是否>1，>1则判定为有数据生成更新区域，否则退出程序
- If x > 1 Then
- s = "[Excel 12.0;imex=0;Database=" & ThisWorkbook.FullName & "].[" & act & [a1].CurrentRegion.Address(0, 0) & "]"
- Else
- Exit Sub
- End If
- End With
- '生成更新SQL语句(请注意Office2007后需要加imex=0参数)
- sql = "update " & DataTable & " a," & s & " b set " & Mid(StrTemp, 2) & " where a.生产订单号=b.生产订单号 and a.产品型号=b.产品型号"
- cnn.Execute sql '不判断，更新可能存在的“SN”
-
- '将工作表信息追加到数据库表
- sql = "insert into " & DataTable & " select * from " & s & " b where not exists"
- sql = sql & "(select * from " & DataTable & " a," & s & " b where b.生产订单号=a.生产订单号)" ' and b.产品型号=a.产品型号)"
- cnn.Execute (sql)
-
- '关闭连接释放内存
- cnn.Close
- Set cnn = Nothing
- MsgBox "保存出货记录成功并上传数据库！", , "保存成功"
- Error = 0
- Exit Sub
- ElseIf i = Sheets.Count Then
- Error = 1
- MsgBox "请修改文件名格式如“订单执行及变更情况_2018年05月”，并将记录订单信息的表单名修改为“2018年05月”，保持与文件名中“_”后的部分一致,请修改后重试!", , "文件名格式不正确"
- End If
- Next
-
- 'ActiveSheet.Protect Password:="vadsys"
- ActiveWorkbook.RemovePersonalInformation = False
- Application.ScreenUpdating = True
- End Sub
test.zip
(909.71 KB, 下载次数: 24)
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-5-21 21:47
楼主