如何让access自动获取外部excel数据？

zhaogang1960

zhcshine 发表于 2014-5-13 13:55
多谢，测试结果实现了把两个工作簿的数据连接起来在Access数据库中生成数据表。
但是之前设定的问题反馈 ...

链接表不能、也不需要修改，因为它就是你链接的那个工作表的“镜子”，工作表修改后，链接表也当然的显示最新数据

zhcshine

zhaogang1960 发表于 2014-5-13 17:27
链接表不能、也不需要修改，因为它就是你链接的那个工作表的“镜子”，工作表修改后，链接表也当然的显示 ...

新问题：

参照“根据工作表批量更新数据库并向数据库添加不存在的记录(不使用循环)2007”帖子内容

1. Private Sub CommandButton1_Click()
   
2. '引用Microsoft ActiveX Data Objects 2.x Library
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim rs As New ADODB.Recordset
   
5.     Dim myPath As String
   
6.     Dim myTable As String
   
7.     Dim strTemp As String
   
8.     Dim arrFields As Variant
   
9.     Shell "net use \\ZHC20120268\data /USER:ZHC20120268 shareuser"
   
10.    
    
11.     myPath = "\\ZHC20120268\data\data1.accdb"
    
12.     myTable = "pla_data"
    
13.     On Error GoTo errmsg
    
14.     cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & myPath '连接数据库
    
15.    
    
16.     arrFields = Range("A2:AE2") '工作表中的字段名写入数组
    
17.    
    
18.     '生成更新字符串，如：a.姓名=b.姓名,a.性别=b.性别,……
    
19.     For i = 2 To UBound(arrFields, 2)
    
20.         strTemp = strTemp & ",a." & arrFields(1, i) & "=b." & arrFields(1, i)
    
21.     Next
    
22.    
    
23.     SQL = "select a.* from [Excel 12.0;Database=" & ActiveWorkbook.FullName & "].[Sheet2$" & Range("a2").CurrentRegion.Address(0, 0) _
    
24.         & "] a left join " & myTable & " b on a.包被码=b.包被码 where b.包被码 is null"
    
25.     Set rs = New ADODB.Recordset
    
26.     rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
27.    
    
28.     '插入数据库不存在记录
    
29.    If rs.RecordCount > 0 Then '如果工作表中含有数据库不存在记录
    
30.        SQL = "insert into " & myTable & " " & SQL '插入新记录SQL语句
    
31.         cnn.Execute SQL
    
32.         MsgBox rs.RecordCount & "行数据已增加到数据库！", vbInformation, "增加数据"
    
33.     Else
    
34.          MsgBox "工作表的数据数据库中已经存在。", vbInformation, "添加数据失败"
    
35.     End If
    
36.    
    
37.     '关闭连接释放内存
    
38.     rs.Close
    
39.     cnn.Close
    
40.     Set rs = Nothing
    
41.     Set cnn = Nothing
    
42.     Exit Sub
    
43. errmsg:
    
44.     MsgBox Err.Description, , "错误报告"
    
45. End Sub

复制代码

测试插入新记录SQL语句可以通过

1. Private Sub CommandButton2_Click()
   
2. Dim cnn As New ADODB.Connection
   
3.     Dim rs As New ADODB.Recordset
   
4.     Dim myPath As String
   
5.     Dim myTable As String
   
6.     Dim strTemp As String
   
7.     Dim arrFields As Variant
   
8.     Shell "net use \\ZHC20120268\data /USER:ZHC20120268 shareuser"
   
9.     myPath = "\\ZHC20120268\data\data1.accdb"
   
10.     myTable = "pla_data"
    
11.     On Error GoTo errmsg
    
12.     cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & myPath '连接数据库
    
13.    
    
14.     arrFields = Range("A2:AE2") '工作表中的字段名写入数组
    
15.    
    
16.     '生成更新字符串，如：a.姓名=b.姓名,a.性别=b.性别,……
    
17.     For i = 2 To UBound(arrFields, 2)
    
18.         strTemp = strTemp & ",a." & arrFields(1, i) & "=b." & arrFields(1, i)
    
19.     Next
    
20.     '生成更新SQL语句(请注意Office2007后需要加imex=0参数)
    
21.     SQL = "update " & myTable & " a,[Excel 12.0;imex=0;Database=" & ActiveWorkbook.FullName & "].[Sheet2$" _
    
22.         & Range("a2").CurrentRegion.Address(0, 0) & "] b set " & Mid(strTemp, 2) & " where a.包被码=b.包被码"
    
23.     cnn.Execute SQL
    
24.    
    
25.     'Set rs = New ADODB.Recordset
    
26.     rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
27.    '
    
28.     '插入数据库不存在记录
    
29.     If rs.RecordCount > 0 Then '如果工作表中含有数据库不存在记录
    
30.       
    
31.       MsgBox rs.RecordCount & "行数据已经更新到数据库！", vbInformation, "更新数据"
    
32.     Else
    
33.          MsgBox "工作表的数据数据库中已经存在。", vbInformation, "添加数据失败"
    
34.    End If
    
35.    
    
36.     '关闭连接释放内存
    
37.     rs.Close
    
38.     cnn.Close
    
39.     Set rs = Nothing
    
40.     Set cnn = Nothing
    
41.     Exit Sub
    
42. errmsg:
    
43.     MsgBox Err.Description, , "错误报告"
    
44. End Sub

复制代码

生成更新SQL语句 却提示对象关闭时，不允许操作，这是为什么？