从 excel 前端访问数据更新

Question

我正在尝试在使用 Excel 前端的 Access 中构建某种班次和活动数据库。我已经设法编写 VBA 代码来导入访问表中的数据，但现在我正在寻找解决方案，以防更新表中已经存在的数据。这是我的导入代码示例：

Sub SaveData()

    Dim cnt As New ADODB.Connection
    Dim strCon As String
    Dim strSQL As String
    Dim strConBckp As String
    Dim mandatoryFields As String

    Dim myRange As Range

radek = Worksheets("data").Range("B4").Value + 1
sloupec = Worksheets("data").Range("B5").Value + 1

For j = 2 To sloupec

    For i = 2 To radek

        dat = Worksheets("Rozpis").Range("A1").Value
        act = Worksheets("Rozpis").Cells(1, j).Value
        jm = Worksheets("Rozpis").Cells(i, 1).Value
        slt = Worksheets("Rozpis").Cells(i, j).Value
        rep = Environ("UserName")

        If slt <> "" Then
' Import

        strCon = "Provider=Microsoft.Ace.OLEDB.12.0; Persist Security Info = False;" & _
                "Data Source=C:\Users\carbolf\Desktop\PLANNER - Copy.accdb;"

                strSQL = "INSERT INTO rozpis_db (Datum, Slot, Alias, Activity, Uložil) SELECT " & "'" & dat & "', '" & jm & "', '" & slt & "','" & act & "','" & rep & "'"

                Set cnt = New ADODB.Connection
                    With cnt
                        .Open strCon
                        .Execute (strSQL)
                    End With
                cnt.Close

                Set cnt = Nothing
        End If

    Next

Next


End Sub

感谢您的任何建议。

Answer 1

我认为您编写的代码应该可以工作，但它需要更好的结构。此外，INSERT 语句需要使用 VALUES，如下所示。

例如考虑：

Sub SaveData()

    Dim cnt As New ADODB.Connection
    Dim strCon As String
    Dim strSQL As String
    Dim strConBckp As String
    Dim mandatoryFields As String
    DIm a as string 

    Dim myRange As Range

    with Worksheets("data")
        radek = .Range("B4").Value + 1
        sloupec = .Range("B5").Value + 1
    end with

    strCon = "Provider=Microsoft.Ace.OLEDB.12.0; Persist Security Info = False;" & _
        "Data Source=C:\Users\carbolf\Desktop\PLANNER - Copy.accdb;"

    Set cnt = New ADODB.Connection
    cnt.Open strCon

    with Worksheets("Rozpis")
        For j = 2 To sloupec

            For i = 2 To radek

                dat = .Range("A1").Value
                act = .Cells(1, j).Value
                jm  = .Cells(i, 1).Value
                slt = .Cells(i, j).Value
                rep = Environ("UserName")

                If slt <> "" Then
                        ' Import

                        a = ""
                        a = a & "INSERT INTO rozpis_db "
                        a = a & " (Datum, Slot, Alias, Activity, Uložil) "
                        a = a & " VALUES ( " 
                        a = a & "'" & dat & "', " 
                        a = a & "'" &  jm  & "', " 
                        a = a & "'" &  slt & "', " 
                        a = a & "'" &  act & "', " 
                        a = a & "'" &  rep & "'   "
                        a = a & ");" 

                        strSQL = a

                        cnt.Execute (strSQL)

                End If

            Next

        Next
    end with 

    cnt.Close
    Set cnt = Nothing

End Sub

请注意，您将所有单元格视为包含字符串。因此，当插入 Access 时，这将尝试在表字段中插入一个空字符串。如果可以的话，它会将其转换为数字。

如果 dat 是一个数字并且可以有空字段（或者 dat 是一个字符串并且您的数据库字段不允许空字符串），那么您可能需要考虑使用这种代码：

替换

dat = .Range("A1").Value

与

dat = Iif(IsEmpty( .Range("A1").Value _ 
          , "NULL", "'" & .Range("A1").Value & "'")

这样代替

a = a & "'" & dat & "', " 

你会使用

a = a & dat & ", " 

它变成了

NULL ,

另请参阅我的回答 here 关于如何更好地在 VBA 中构建 SQL

哈维

Answer 2

这里有一些代码可以让 excel 从 access 数据库中获取数据。 以防万一你觉得它有用... （我知道它没有直接回答你的问题，但它是相关的。）

    'Define Variables
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlSheet As Object
    Dim oAdoConnect As Object
    Dim adoRecordset As ADODB.Recordset
    Dim lngColumn  As Long
    Dim strNewFile As String
    Dim strFilePath As String
    Dim strSQL As String

    'Always have a way to handle errors
    On Error GoTo Handler

    'Establish your ADO connection
    Set oAdoConnect = CreateObject("ADODB.Connection")
    oAdoConnect.Provider = "Microsoft.ACE.OLEDB.12.0"
    oAdoConnect.Open = Application.ActiveWorkbook.Path & "\Inventory.mdb"

    'Create the SQL statement
    strSQL = _
        "SELECT Customers.* " & _
        "FROM Customers " & _
        "WHERE (((Customers.ContactName) Like ""M*""));"

    'Create and open your recordset
    Set adoRecordset = CreateObject("ADODB.Recordset")
    adoRecordset.Open strSQL, oAdoConnect, adOpenStatic, adLockReadOnly

    'Create your Excel spreadsheet
    Set xlApp = Application
    Set xlWorkbook = xlApp.Workbooks.Add

    'Add the new Worksheet
    With xlWorkbook
        Set xlSheet = .Worksheets.Add
        xlSheet.Name = "Customers"

        ' Adds field names as column headers
        For lngColumn = 0 To adoRecordset.Fields.Count - 1
            xlSheet.Cells(1, lngColumn + 1).Value = adoRecordset.Fields(lngColumn).Name
        Next

        xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, adoRecordset.Fields.Count)).Font.Bold = True
        xlSheet.Range("A2").CopyFromRecordset adoRecordset
    End With

    'Close the RecordSet
    adoRecordset.Close

    'Cleanup variables
    Set adoRecordset = Nothing
    Set oAdoConnect = Nothing
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
    Exit Sub

Handler:
    MsgBox _
        "An Error Occurred!" & vbNewLine & vbNewLine & _
        "Error Number: " & Err.Number & vbNewLine & vbNewLine & _
        "Error Message: " & vbNewLine & Err.Description & vbNewLine & vbNewLine & _
        "Error Source: " & Err.Source, vbOKOnly, "Error"
    Exit Sub
End Sub