根据工作表批量更新Access数据库并向数据库添加不存在的记录(不使用循环)

tclnxc

终于已解决

BeMin

赵老师，初学求教
如果不用判断是否重复，直接添加表格内容到数据库，语句要怎么修改？

zhaogang1960

BeMin 发表于 2014-7-30 11:05
赵老师，初学求教
如果不用判断是否重复，直接添加表格内容到数据库，语句要怎么修改？

1. Sub updateaddRecords2003()
   
2.     Dim cnn As New ADODB.Connection
   
3.     Dim myPath As String
   
4.     Dim myTable As String
   
5.     Dim SQL As String
   
6.     myPath = ThisWorkbook.Path & "\学校管理.mdb"
   
7.     myTable = "学生档案"
   
8.     On Error GoTo ErrMsg
   
9.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath '连接数据库
   
10. 
    
11.     SQL = "INSERT INTO " & myTable & " SELECT * FROM [Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[数据$" & Range("a1").CurrentRegion.Address(0, 0) & "]"
    
12.     cnn.Execute SQL
    
13.     MsgBox "纪录添加成功。", vbInformation, "添加纪录"
    
14.     cnn.Close
    
15.     Set cnn = Nothing
    
16.     Exit Sub
    
17. ErrMsg:
    
18.     MsgBox Err.Description, , "错误报告"
    
19. End Sub
    

复制代码

zhaogang1960

因为数据有重复，所以需要取消数据库中学生编号字段这个主键
请看附件
附件.rar (289.55 KB, 下载次数: 191)

2014-7-30 17:10 上传

点击文件名下载附件

任浪漫

谢谢赵版分享！下载学习了。

wsunday

不断升级中！

linyh1742595842

zhaogang1960 发表于 2013-6-3 16:32
2007代码稍有区别：

Sub 读出access数据()
    Dim cnn As New ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim myPath As String
    Dim SQL As String
    Dim i As Integer
    Dim sh As Worksheet
    myPath = ThisWorkbook.Path & "\jiageguanli.mdb"
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & myPath
    For Each sh In Worksheets
        SQL = "SELECT * FROM " & sh.Name
        Set rs = cnn.Execute(SQL)
        sh.Range("A1").CurrentRegion.ClearContents
        For i = 0 To rs.Fields.Count - 1
            sh.Cells(1, i + 1) = rs.Fields(i).Name
        Next
        sh.Range("A2").CopyFromRecordset rs
    Next
    MsgBox "读出access数据完毕。", vbInformation
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub
老师请问这段代码，也是老师写的，现在我的工作薄还有其他和数据库里面不一样的工作表，我想
从我想的位置开始，比如第10个工作表开始，请问如何修改代码

zhaogang1960

linyh1742595842 发表于 2015-1-12 17:43
Sub 读出access数据()
    Dim cnn As New ADODB.Connection
    Dim rs As ADODB.Recordset

1. Sub 读出access数据()
   
2.     Dim cnn As New ADODB.Connection
   
3.     Dim rs As ADODB.Recordset
   
4.     Dim myPath As String
   
5.     Dim SQL As String
   
6.     Dim i As Integer
   
7.     Dim l As Integer
   
8.     myPath = ThisWorkbook.Path & "\jiageguanli.mdb"
   
9.     cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & myPath
   
10.     For l = 10 To Worksheets.Count
    
11.         With Worksheets(l)
    
12.             SQL = "SELECT * FROM " & .Name
    
13.             Set rs = cnn.Execute(SQL)
    
14.             .Range("A1").CurrentRegion.ClearContents
    
15.             For i = 0 To rs.Fields.Count - 1
    
16.                 .Cells(1, i + 1) = rs.Fields(i).Name
    
17.             Next
    
18.             .Range("A2").CopyFromRecordset rs
    
19.         End With
    
20.     Next
    
21.     MsgBox "读出access数据完毕。", vbInformation
    
22.     rs.Close
    
23.     cnn.Close
    
24.     Set rs = Nothing
    
25.     Set cnn = Nothing
    
26. End Sub

复制代码

linyh1742595842

zhaogang1960 发表于 2015-1-12 17:52

感谢老师！
一直在研究老师写的代码

linyh1742595842

zhaogang1960 发表于 2015-1-12 17:52

老师您好！
Sub 写入access数据()
    Dim cnn As New ADODB.Connection
    Dim myPath As String
    Dim s As String
    Dim t As String
    Dim SQL As String
    Dim arr As Variant
    Dim i As Integer
    Dim sh As Worksheet
    myPath = ThisWorkbook.Path & "\jiageguanli.mdb"
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & myPath
    For Each sh In Worksheets
     arr = sh.Range("A1").CurrentRegion
        If UBound(arr) > 1 Then
            s = ""
            t = ""
            For i = 2 To UBound(arr, 2)
                s = s & ",A." & arr(1, i) & "=B." & arr(1, i)
                t = t & ",A." & arr(1, i)
            Next
            SQL = "UPDATE " & sh.Name & " A,[Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[" & sh.Name & "$" _
                & sh.Range("A1").CurrentRegion.Address(0, 0) & "] B SET " & Mid(s, 2) & " WHERE A.zdbh=B.zdbh"
            cnn.Execute SQL '更新已存在的数据
            SQL = "INSERT INTO " & sh.Name & " SELECT " & Mid(t, 2) & " FROM [Excel 8.0;Database=" & ThisWorkbook.FullName & ";].[" & sh.Name & "$" & sh.Range("A1").CurrentRegion.Address(0, 0) _
                & "] A LEFT JOIN " & sh.Name & " B ON A.zdbh=B.zdbh WHERE B.zdbh IS NULL"
            cnn.Execute SQL '插入不存在的数据
        End If
    Next
    MsgBox "数据修改、写入成功。", vbInformation
    cnn.Close
    Set cnn = Nothing
End Sub
这个也老师写的代码
请问在写入数据到access数据库时要注意什么
为什么我的不可以写入