将值附加到excel的Access表中自动生成ID

Question

我有一个访问数据库，其中有一些表格每天都会更新一些值。我需要这些表有一个ID字段，当从Excel导入表的其他值时自动生成该ID字段。我想通过保持一个按钮并写一个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时，都会自动增加一个新的数字。

Answer 2

以下将从excel中写入访问，并且正如之前的评论提到的那样在数据字段类型中使用自动编号。

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 

Answer 3

我创建了一个Excel电子表格名为ExcelData.xlsx与您所提供格式化为一个表格样本数据：

我然后创建一个表单的一个按钮来运行一些VBA将数据导入到Access（按钮的名称是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 

这将导致这些表中..

个

在tblProducts与ID表..with新的数据应用：

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