对外部数据源进行复制、新增、删除

魂断蓝桥

exc-led 发表于 2018-9-12 16:43
引用出来，然后怎么让xsl中的数据来回写到SQL中的数据库中呢？版主大大能否帮助实现一下？我还是无法知道 ...

代码审核后中，我也无法啊

别返回数据给数据库，如果错了，很麻烦的。

魂断蓝桥

Sub a()
Dim cnn As New cConnection, sql$, s$, bt$
Dim rs As New cRecordset, i%, j%
If [A2] = "" Then Call b
Dim arr
arr = [A1].CurrentRegion
For i = 1 To UBound(arr, 2)
    s = s & "[" & arr(1, i) & "],"
Next
s = s & " primary key([采购单创建日期],[请购/委外单号],[单号])"
sql = "CREATE TABLE T1(" & s & ")"
cnn.CreateNewDB ":memory:"
cnn.Execute sql
cnn.BeginTrans
s = ""
For i = 2 To UBound(arr)
    For j = 1 To UBound(arr, 2)
        s = s & MYV(arr(i, j)) & ","
    Next
        s = Left(s, Len(s) - 1)
        sql = "INSERT INTO T1 VALUES(" & s & ")"
        cnn.Execute sql
        s = ""
Next
arr = Sheet1.[A1].CurrentRegion
For j = 1 To UBound(arr, 2)
    bt = bt & "[" & arr(1, j) & "],"
Next
bt = Left(bt, Len(bt) - 1)
s = ""
For i = 2 To UBound(arr)
    sql = "SELECT * FROM  T1 WHERE [采购单创建日期]=" & MYV(arr(i, 1)) _
            & " AND [请购/委外单号]=" & MYV(arr(i, 2)) _
            & " AND [单号]=" & MYV(arr(i, 3))
    rs.OpenRecordset sql, cnn
    If rs.RecordCount = 0 Then
        s = ""
            For j = 1 To UBound(arr, 2)
                s = s & MYV(arr(i, j)) & ","
            Next
            s = Left(s, Len(s) - 1)
            sql = "REPLACE INTO T1(" & bt & ") VALUES(" & s & ")"
            cnn.Execute sql
            s = ""
    Else
        s = ""
        For j = 4 To UBound(arr, 2)
                s = s & "[" & arr(1, j) & "]=" & MYV(arr(i, j)) & ","
        Next
            s = Left(s, Len(s) - 1)
            sql = ""
            sql = "UPDATE T1 SET " & s
            cnn.Execute sql
    End If
Next
cnn.CommitTrans
[A2:Y9999] = ""
sql = "SELECT * FROM T1"
rs.OpenRecordset sql, cnn
[A2].CopyFromRecordset rs.DataSource
Set rs = Nothing
Set cnn = Nothing
End Sub
Sub b()
Dim r
r = Sheet1.[a99999].End(3).Row
Sheet1.Range("a2:v" & r).Copy [A2]
End Sub

Public Function MYV(myt)
If Trim(Len(myt)) = 0 Then
    MYV = "''"
ElseIf TypeName(myt) = "String" Then
    MYV = "'" & myt & "'"
ElseIf IsDate(myt) Then
    MYV = "'" & Format(myt, "YYYY-MM-DD") & "'"
Else
    MYV = myt
End If
End Function

魂断蓝桥

exc-led 发表于 2018-9-12 16:43
引用出来，然后怎么让xsl中的数据来回写到SQL中的数据库中呢？版主大大能否帮助实现一下？我还是无法知道 ...

xls 数据返回给你定义的数据库即可。

exc-led

魂断蓝桥 发表于 2018-9-12 16:45
代码审核后中，我也无法啊

别返回数据给数据库，如果错了，很麻烦的。

没有代码例子，我是真的不知道怎么去编写....好痛苦

exc-led

魂断蓝桥 发表于 2018-9-12 16:45
Sub a()
Dim cnn As New cConnection, sql$, s$, bt$
Dim rs As New cRecordset, i%, j%

万分感谢版主大大，我会试着运行，再次万分感谢！！

exc-led

魂断蓝桥 发表于 2018-9-12 16:46
xls 数据返回给你定义的数据库即可。

版主，我最近几天一直搞不懂这个MS数据返写到SQL数据库。首先，
Private Sub CommandButton1_Click()
    Dim conn As New ADODB.Connection
    conn.Open "Driver={SQL Server};server=192.168.1.240;uid=sa;pwd=excsqlserver;database=EXCERP;"

    Dim cmd As New ADODB.Command
    cmd.CommandType = adCmdStoredProc
    cmd.CommandText = "dbo.ERPJQ2"
    cmd.ActiveConnection = conn

    Dim RST As New ADODB.Recordset
    RST.Open cmd, , adOpenForwardOnly, adLockReadOnly

    Range("a1").CopyFromRecordset RST

    conn.Close

End Sub

也不知道是不是这样的？运行后导出来的数据少了一半，而且没有行头名称
我用的是SQL中ODBC数据源导出到MS，但您给我的，我一直没看懂0.0  版主能否抽空帮我看看？我真的是个小白，关键还有就是链接的SQL数据库中的存储过程中的表，其实无非就是想在原始表sheet2中直接点击“上传”按钮，直接把修改后的Q、R、S三列数据回写到SQL的数据库中，望版主赐教。谢谢