Question

我正在尝试在Access中构建一些shift和activity DB，这是使用excel前端。我已经设法编写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

The code you've written should work I think, but it needs better structure. Also the INSERT statement needs to use VALUES as shown below.

For instance consider:

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

Note that you are treating all cells as if they contain a string. So when inserting into Access this will try to insert an empty string into the table field. It will convert it to number if it can.

If dat is a number and can have empty fields (or dat is a strign and you database field will not allow empty strings) then you might want to consider using this sort of code:

replace

dat = .Range("A1").Value

with

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

so that instead of

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

you would use

a = a & dat & ", "

and it becomes

NULL ,

Also see my answer here about how to structure SQL in VBA better

Harvey

Answer 2

Here's some code that will allow excel to grab data from an access database. Just in case you find it useful... (I know it's not answering your question directly but it is related. )

    '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

从excel前端访问数据更新

2 个答案: