求助，EXCEL通过VBA操作SQL数据库

要做一个EXCEL为前台 操作SQL数据库的VBA，读取OK了。但写入怎么都不行。请求帮助！

Sub CommandButton2_Click()
 Dim cnn As Object, rs As Object, SQL$
    Dim a, arr, i&, j&, l&, s$, k, t, d As Object
    Set d = CreateObject("scripting.dictionary")
    arr = [a3].CurrentRegion '工作表数据区域写入数组

    
'    用字典记录每个姓名出现在工作表中的行号
    For i = 2 To UBound(arr)
        s = arr(i, 3) & Chr(9) & arr(i, 4)
        If Not d.Exists(s) Then
            d(s) = i
        Else
            d(s) = d(s) & "," & i
        End If
    Next
    k = d.keys '不重复的姓名信息
    t = d.items '不重复的姓名出现的行号
    
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "Provider=sqloledb;Server=127.0.0.1;Database=UserData;Uid=admin;Pwd=123456"
    
'    更新数据库中存在的数据
    For i = 0 To d.Count - 1
        a = Split(k(i), Chr(9)) '分离name、ID
        SQL = "select * from dbo.data where name='" & a(0) & "' and  ID='" & a(1) & "'" '查询该人员在数据除中记录
        Set rs = CreateObject("adodb.Recordset")
        rs.Open SQL, cnn, 1, 3
        n = rs.RecordCount '记录数
        If n > 0 Then '如果有记录
            a = Split(t(i), ",") '分离该人员在工作表中出现的行号
            For j = 0 To UBound(a) '逐个行号
                If j + 1 > n Then Exit For '如果工作表中该人员记录次序大于数据库中的记录数则退出循环
                rs.Move j, 1 '把指针移动到该人员出现次序的位置
                For l = 5 To 34 '逐列数据更新到数据库
                    rs.Fields(l - 1) = arr(a(j), l)
                Next l
                rs.Update '更新
            Next j
        End If
    Next i
    
'    下面是插入数据库中不存在的记录
    SQL = "select a.* from [Excel 12.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a3].CurrentRegion.Address(0, 0) _
        & "] a left join dbo.data b on a.ID=b.ID and a.name=b.name  where b.ID is null"
    Set rs = CreateObject("adodb.recordset")
    rs.Open SQL, cnn, 1, 3   ‘报错~提示上面的SQL无效。
    If rs.RecordCount Then
        SQL = "insert into dbo.data " & SQL
        cnn.Execute SQL
        MsgBox rs.RecordCount & "行数据已经添加到数据库！", vbInformation
    Else
         MsgBox "工作表的数据数据库中已经存在。", vbInformation
    End If
    
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    End Sub

4 个解决方案

#1

debug.print 你得SQL语句，看看语句字符串构造的是否正确，差个空格什么的都会报错。

#2

把写入的SQL 语句显示出来，拷贝到SQL 里执行，根据错误改正。

#3

用ACCESS数据库可以。但用SQL就不行。

#4

直接用单元格的值构成SQL语句，然后执行，下面是我用在Oracle数据库中的实例：

’。。。。。。
    If OraOpen Then lineno = Worksheets("客户明细").[A65536].End(xlUp).Row Else lineno = 0       '行数
    
    For row1 = 2 To lineno
        If Worksheets("客户明细").Cells(row1, 4) = "变更" Then
            CustCode = LTrim(RTrim(Worksheets("客户明细").Cells(row1, 1)))
            CustName = Worksheets("客户明细").Cells(row1, 2)
            OpenDate = Worksheets("客户明细").Cells(row1, 3)
            sqls = "select count(*) from EMSAPP_COST_CLIENT where cust_code ='" & CustCode & "'"
            Set rst = cnn.Execute(sqls)
            
            If rst(0) > 0 Then
                'ID已经存在，更新客户资料
                 sqls = "update EMSAPP_COST_CLIENT set cust_name='" & CustName
                 sqls = sqls & "',open_date=to_date('" & OpenDate & "','yyyy-mm-dd') where cust_code= '" & CustCode & "'"
                 remark = "已更新"
            Else
                sqls = "insert into EMSAPP_COST_CLIENT (cust_code,cust_name,open_date) values ('"
                sqls = sqls & CustCode & "','" & CustName & "',to_date('" & OpenDate & "','yyyy-mm-dd'))"
                remark = "已保存"
            End If
            If sqls <> "" Then
                'MsgBox sqls
                Set rst = cnn.Execute(sqls)
                Worksheets("客户明细").Cells(row1, 4) = remark
            End If
        End If
    Next row1
‘。。。。。。