0

我有一些 VBA，我想用它来更新数据并将数据添加到 SQL 服务器上的表中。我整天在 VBA 中对这个功能的了解有限，搜索各种网站并没有真正得到任何答案以使事情点击到位并且在其他地方发布时没有得到任何响应。希望我能在这里解决这个问题。

因此，我将以下代码拼凑在一起：

Sub connectsqlserver()
Dim conn As ADODB.Connection
Dim recset As ADODB.Recordset
Set conn = New ADODB.Connection
Set recset = New ADODB.Recordset
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim msgstrng As String
Dim newstring As String
 If conn.State <> 0 Then
 conn.Close
 End If
 With conn
    .ConnectionString = "Driver={SQL Server};server=sage500;Database=CS3Live;Uid=sa;Pwd=pass; ReadOnly=False;"""
    .ConnectionTimeout = 5
    .Open
  End With
 recset.Open Source:="custinfosheetdata", ActiveConnection:=conn, CursorType:=adOpenKeyset, LockType:=adLockOptimistic
 
 
 If Sheets("Changes").Range("A1").Value <> 0 Then
 For i = 1 To Sheets("Changes").Range("A1").Value
    recset.Find "Col2 = " & Sheets("Changes").Cells(2, i + 2) 'find the value in B from B3 onwards
    'Do something
 Next i
 Sheets("Changes").Rows("3:" & i + 2).Delete xlUp
 Else
 i = 0
 End If
 If Sheets("New").Range("A1").Value <> 0 Then
 For j = 1 To Sheets("New").Range("A1").Value
    newstring = ""
    For k = 1 To 38
    If k = 38 Then
    newstring = newstring & "'" & Cells(j + 2, k).Value & "'"
    Else
    newstring = newstring & "'" & Cells(j + 2, k).Value & "', "
    newstring = Format(newstring, "")
    End If
    Next k
    Debug.Print (newstring)
    With recset
    .AddNew (newstring)
    .Update
    End With
 Next j
 Sheets("New").Rows("3:" & j + 2).Delete xlUp
 Else
 j = 0
 End If
 recset.Close
 conn.Close
 If i = 0 And j = 0 Then
 msgstring = "No Changes/New Data to add"
 Else
 If i = 0 And j <> 0 Then
 msgstring = "No Changes and " & j & " New Customers added"
 Else
 If i <> 0 And j = 0 Then
 msgstring = i & " Changes and no New Customers added"
 Else
 msgstring = i & " Changes and " & j & " New Customers added"
 End If
 End If
 End If
End Sub

第 1 部分：这当前在“With recset.AddNew ...”（3001）处抛出一个错误，指出参数的类型错误。它将被格式化为 nvarchar(255) 的表格，并且所有数据都被格式化为各个字段中的文本，所以我不完全确定那里发生了什么。

第 1 部分代码：

If lastrow <> 0 Then
 For j = 1 To lastrow
    For k = 1 To lastfield
    If k = lastfield Then
    newstring = newstring & "'" & Cells(j + 2, k).Value & "'"
    Else
    newstring = newstring & "'" & Cells(j + 2, k).Value & "', "
    newstring = Format(newstring, "")
    End If
    Next k
    With recset
    .AddNew (newstring)
    .Update
    End With
 Next j
 End If

第 2 部分：由于我对用于 ADODB 连接的 VBA 的了解充其量是糟糕的，一旦找到所需的行，我无法弄清楚如何继续，因此“做某事”行。我需要做的是从“更改”excel表中的B列中找到匹配的记录，然后在SQL表中编辑该行以匹配它。我无法弄清楚如何做到这一点。第 2 部分代码：

 If lastrow <> 0 Then
 For i = 1 To lastrow
        recset.Find "Col2 = " & Sheets("Changes").Cells(2, i + 2) 'find the value in B from B3 onwards
' Do something
 Next i
     End If

编辑：我从 debug.print 得到这个，它可以帮助一些人更多地想象这个：

"23/07/13","TEST123","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test","Test"

这是一个完整的行（因此不需要字段列表，因为这是按正确顺序排列的每一列的数据）。

4

2 回答 2

2

从您发布的内容来看，我相信您一直在尝试将所有值连接成一个由“，”分隔的字符串。（如我错了请纠正我）

此答案仅在您想附加新数据时才有用，如果您想在数据库中查找特定记录并更新它，那么它是一个完全不同的故事。

“添加新”方法接受两个参数。

  1. 数组格式的字段列表
  2. 数组格式的值列表

除非您只有一个字段或一个值要添加，否则您应该在使用“添加新”方法之前将它们放入数组中。

构造数组的一种可能方法：

For i = 0 to count_of_fields
    aryFields(i) = field_value
Next
For i = 0 to count_of_values
    aryValues(i) = value
Next
recset.AddNew aryFields,aryValues
recset.Update

让我知道这是否有帮助！

于 2013-07-22T14:32:45.987 回答
0

现在将实际发布而不是星期一发布，否则我可能会忘记。

最终成为最简洁的解决方案，因为在这种情况下使用数组似乎失败了很多，而且它们更难调试。这至少让它变得简单了很多。

此外，很好地发现，一旦你找到了行（我的第 2 部分问题），它实际上与 .addnew 的过程相同（这是我不确定的）

With conn
    .ConnectionString = "Driver={SQL Server};server=sage;Database=CS3Live;Uid=sa;Pwd=pass; ReadOnly=False;"""
    .Open
  End With
 recset.Open Source:="custinfosheetdata", ActiveConnection:=conn, CursorType:=adOpenKeyset, LockType:=adLockOptimistic

 If Sheets("Changes").Range("A1").Value <> 0 Then
    For i = 3 To LastRow
        With recset
            .Find "Col2 = " & "'" & Sheets("Changes").Range("B" & i) & "'"
            For k = 1 To 38
                strField = Sheets("Changes").Cells(2, k).Value
                varValue = Sheets("Changes").Cells(i, k).Value
                .Fields(strField).Value = varValue
            Next k
            .Update
        End With
    Next i
 Else
 i = 0
 End If

 If Sheets("New").Range("A1").Value <> 0 Then
     For j = 3 To LastRow
        With recset
           .AddNew
            For k = 1 To 38
                strField = Sheets("New").Cells(2, k).Value
                varValue = Sheets("New").Cells(j, k).Value
                .Fields(strField).Value = varValue
            Next k
            .Update
        End With
    Next j
 Else
 j = 0
 End If
... etc

所以无论如何，感谢所有尝试在这里提供帮助的人。我仍然无法理解为什么数组不起作用。

于 2013-07-26T15:01:42.353 回答