从具有ID自动生成ID的Excel附加到Access表的值

Question

我有一个访问数据库，其中包含一些每日更新一些值的表格。我需要表格有一个ID字段，当从excel导入表格的其他值时，该字段会自动生成。我希望通过保留按钮和编写VBA代码来自动完成所有操作。现在我有一个将值导入表中的表单，但它只导入了我拥有的确切值。我还需要一个额外的ID列，在导入时必须自动生成。请帮帮我。

Excel表格样本：

ProductName |   ProductValue
------------+------------------
ABC         |   76
SDF         |   87

数据库表

ID  |   ProductName |   Product Value
----+---------------+-----------------
1   |   ABC         |   76
2   |   SDF         |   87

Excel工作表使用新值更新每个日期，并且必须将其放入访问数据库，ID会自动递增。

Answer 1

在Access中创建表时，您要为要创建的新列的数据类型指定不同的选项。其中一种数据类型称为“自动编号”。这里有一些信息：http://en.wikipedia.org/wiki/AutoNumber

将列ID设置为autoNumber并将其设为主键。现在，每次在表ID中插入关系时，ID都会自动增加一个新数字。

Answer 2

我创建了一个名为ExcelData.xlsx的Excel电子表格，其中提供的样本数据格式化为表格：

然后我创建了一个带有按钮的表单来运行一些将数据导入Access的VBA（按钮名称为cmdImport）：

作为表单VBA的一部分，我编写了一个检查表是否存在的函数。表的名称作为函数的参数给出，如果找到则函数返回TRUE，否则返回FALSE：

Public Function TableExists(name As String) As Boolean

    ' A function to check whether a table exists
    ' Pass the name of the table as the argument
    ' the function will return TRUE if found or FALSE if not found

    TableExists = DCount("*", "MSysObjects", "Name = '" & name & "' AND Type = 1")

End Function

..然后在cmdImport按钮的点击事件中我有以下内容（您需要根据您的特定情况替换一些内容，例如Excel电子表格的文件路径和文件名） ：

Private Sub cmdImport_Click()

' 1 - Delete your Access table "tblProducts" so we can reset the Autonumber field

    If _
        TableExists("tblProducts") = True _
    Then

        ' Delete old "tblProducts":
        DoCmd.DeleteObject acTable, "tblProducts"

    Else

        ' Do nothing as table doesn't already exist

    End If

' 2 - Create and define new Access table "tblProducts"... this allows us to reset the Autonumber values for the ID fields

    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fldID As DAO.Field, fldProductName As DAO.Field, fldValue As DAO.Field

    Set db = CurrentDb

    ' Create table defintion
    Set tdf = db.CreateTableDef("tblProducts")

    ' Create field definitions
    Set fldID = tdf.CreateField("ID", dbLong)
    fldID.Attributes = dbAutoIncrField
    fldID.Required = True

    Set fldProductName = tdf.CreateField("ProductName", dbText)
    fldProductName.AllowZeroLength = False
    fldProductName.Required = True

    Set fldValue = tdf.CreateField("ProductValue", dbText)
    fldValue.AllowZeroLength = False
    fldValue.Required = True

    ' Append fields to table
    tdf.Fields.Append fldID
    tdf.Fields.Append fldProductName
    tdf.Fields.Append fldValue

    ' Append table to db
    db.TableDefs.Append tdf

    ' Give it a nudge
    db.TableDefs.Refresh
    Application.RefreshDatabaseWindow

    ' Clean up memory
    Set fldID = Nothing
    Set fldProductName = Nothing
    Set fldValue = Nothing
    Set tdf = Nothing
    Set db = Nothing

' 3 - Check for the old imported data from Excel ("ExcelData") and delete it

    If _
        TableExists("ExcelData") = True _
    Then

        ' Delete old "Excel Data":
        DoCmd.DeleteObject acTable, "ExcelData"

    Else

        ' Do nothing as table doesn't already exist

    End If

' 4 - Import new data from Excel ("ExcelData")

    DoCmd.TransferSpreadsheet acImport, _
                              9, _
                              "ExcelData", _
                              "C:/Your/File_Path/And_File_Name.xlsx", _
                              -1

' 5 - Append new data from "ExcelData" in to "tblProducts"

    Dim sqlAppend As String

    sqlAppend = "INSERT INTO tblProducts ( ProductName, ProductValue )" _
              & " SELECT ExcelData.ProductName, ExcelData.ProductValue" _
              & " FROM ExcelData;"

    CurrentDb.Execute sqlAppend

End Sub

这应该导致这些表..

..使用已应用ID的tblProducts表中的新数据：

请注意，此方法会完全覆盖之前导入的所有内容，然后重新导入它，并再次将ID字段分配给所有新数据。这意味着，例如，在先前导入中具有ID为1的记录可能在下次导入时获得不同的ID号，具体取决于Excel电子表格中的记录顺序是否在新导入时更改

Answer 3

下面将从excel写入访问，并且正如前面提到的注释在数据字段类型中使用autonumber。

Sub LogRecord()

 Dim strSQL As Variant
 Dim accApp As Object
 Dim srcs As Variant
 Dim msg1 As Variant


'your access db
srcs = "C:\Documents and Settings\user\My Documents\Programs\Past Versions\Database V2.mdb"  ''' Live location '''

strSQL = "Select * from [tablename];"


Set accApp = GetObject(srcs, "access.Application")
Set Db = DAO.OpenDatabase(srcs)
Set rs = Db.OpenRecordset(strSQL)
    accApp.Visible = False

 For clref = 1 To Range("A500000").End(xlUp).Row
   Cells(clref, 1).Activate

   On Error Resume Next
       If Len(Cells(clref, 1)) >= 1 Then
           rs.AddNew

           rs![Field1] = Sheets("Gather").Cells(clref, 1).Value
           rs![Field2] = Sheets("Gather").Cells(clref, 2).Value
           rs![Field3] = Sheets("Gather").Cells(clref, 3).Value

           rs.Update
       End If

   Next clref

       If Not rs Is Nothing Then rs.Close

       Set rs = Nothing
       Set Db = Nothing
       accApp.DoCmd.RunSQL strSQL
       accApp.Application.Quit


   End Sub