如何将excel电子表格传输到access数据库

Question

我正在制作一个程序来跟踪我的体重、我一天摄入的卡路里和日期，以帮助我减肥。我手动将这些值放入包含这三列（日期、卡路里、体重）的电子表格中。我想将这三列中的信息传输到访问数据库中。

到目前为止的代码：

Sub transferdata()

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

connStr = "C:\Users\sachu\Desktop\Assignment 5\CalorieDatabase.mdb"
providerStr = "Microsoft.ACE.OLEDB.12.0"

    With cn
        .ConnectionString = connStr
        .Provider = providerStr
        .Open
    End With

rs.Open sqlStr, cn
rs.Close
cn.Close
End Sub

到目前为止，我的代码只是开始访问和excel之间的连接

Answer 1

有很多方法可以做到这一点。让我们看几个案例研究。

 Export data from Excel to Access (ADO)

如果您想将数据从 Excel 工作表导出到 Access 表，下面的宏示例显示了如何做到这一点。

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\FolderName\DataBaseName.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable  
    ' all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

还有。 . .

 Export data from Excel to Access (DAO)

如果要将数据从 Excel 工作表导出到 Access 表，下面的宏示例说明了另一种方法。

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
    Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb") 
    ' open the database
    Set rs = db.OpenRecordset("TableName", dbOpenTable) 
    ' get all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

还有。 . .

Browse to a single EXCEL File and Import Data from that EXCEL File via TransferSpreadsheet (VBA)

这里还有另一种方式。 . . 子 TryThis()

        Dim strPathFile As String
        Dim strTable As String, strBrowseMsg As String
        Dim strFilter As String, strInitialDirectory As String
        Dim blnHasFieldNames As Boolean

        ' Change this next line to True if the first row in EXCEL worksheet
        ' has field names
        blnHasFieldNames = False

        strBrowseMsg = "Select the EXCEL file:"

        ' Change C:\MyFolder\ to the path for the folder where the Browse
        ' window is to start (the initial directory). If you want to start in
        ' ACCESS' default folder, delete C:\MyFolder\ from the code line,
        ' leaving an empty string as the value being set as the initial
        ' directory
        strInitialDirectory = "C:\MyFolder\"

        strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")

        strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
              Filter:=strFilter, OpenFile:=False, _
              DialogTitle:=strBrowseMsg, _
              Flags:=ahtOFN_HIDEREADONLY)

        If strPathFile = "" Then
              MsgBox "No file was selected.", vbOK, "No Selection"
              Exit Sub
        End If

        ' Replace tablename with the real name of the table into which
        ' the data are to be imported
        strTable = "tablename"

        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
              strTable, strPathFile, blnHasFieldNames

        ' Uncomment out the next code step if you want to delete the
        ' EXCEL file after it's been imported
        ' Kill strPathFile

End Sub

Answer 2

我知道这看起来像是一条死线，但我想为 Office 360​​ 用户恢复活力。我必须从多个来源编译答案以使某些东西可行。见下文。

首先请注意，您至少需要在工具>参考菜单中激活以下 2 个参考。

Microsoft Access 16.0 对象库 & Microsoft Office 16.0 Access 数据库引擎对象

您可能还需要： Visual Basic 应用程序// Microsoft Excel 16.0 对象库// OLE 自动化// Microsoft Forms 2.0 对象库// Microsoft Outlook 16.0 对象库// Microsoft Office 16.0 对象库

Sub rtnExporttoAccess()
Dim oDAO As DAO.DBEngine, oDB As DAO.Database, oRS As DAO.Recordset
Dim oSelect As Range, sPath As String, sRecordSet As String
Set sheet = ActiveWorkbook.Worksheets("YourSheet") 'excel sheet
Set table = sheet.ListObjects.Item("YourTable") 'excel table
Set oSelect = table.ListRows(table.ListRows.Count).Range 'set your sheet and range however you want
sPath = "your database file path"

sRecordSet = "the title of the table in that database" 'access table
Set oDAO = New DAO.DBEngine
Set oDB = oDAO.OpenDatabase(sPath)
Set oRS = oDB.OpenRecordset(sRecordSet)

oRSct = oRS.Fields.Count
xclFieldCt = table.ListColumns.Count
If oRSct > xclFieldCt Then
    intTargetCt = oRSct
Else
    intTargetCt = xclFieldCt
End If

For i = 2 To oSelect.Rows.Count
    oRS.AddNew
'finds the correct fields to add data to
    For j = 0 To intTargetCt - 1    'access is base 0 so the end is always -1
          oRSHeaderName = oRS.Fields(j).Name 'gets database table variable header name
          For col = 1 To intTargetCt  'excel is base 1
                   lastRowHeaderName = table.HeaderRowRange(1, col) ' gets excel table variable header name
                   If oRSHeaderName = lastRowHeaderName Then  'this verifies both headers are the same
                       oRS.Fields(j) = Now
                       Exit For
                   End If
                   If oRSHeaderName = "Pass/Failed" And lastRowHeaderName = "Pass/Failed" Then 'this verifies the you are putting the data where you want it if headers arent the same.
                       oRS.Fields(j) = cbxPF
                       Exit For
                   End If
          Next col
    Next j
    oRS.Update
Next i
oDB.Close
End Sub

ASH 的第二个 DAO 选项基本上也是这段代码。我包含了参考资料并提供了一些额外的选项供您查看更多示例。

Answer 3

创建一个独立的 Acces DB，然后在其中链接 Excel。 Access 具有通过实时通信从 Excel 导入数据的工具。 按照这个：

1. 打开 MS Access
2. 创建新的空白数据库（在此步骤中，您必须为数据库命名，并设置保存位置）
3. 在“外部数据”选项卡上的新数据库中，根据您要导入的内容选择要添加的正确类型（在这种情况下，您必须选择 Excel）
   • 在早期的 MS Access 版本中，流行的可插入的东西被拉伸了
   • 在 2016 版和 O365 中，选项更加紧凑，因此有一个名为“新数据源”的选项包含所有可能性

4. 导入过程包含几个步骤。

   1. 您必须选择源并设置导入数据的方式。您可以将数据作为副本导入到 Access 中的新表中，也可以将数据源连接到 Access 数据库。选择连接源数据进行实时通信。
   2. 选择内部数据源（例如要导入的工作表或范围）
   3. 设置第一行是否包含标题
   4. 为链接表命名

最后将 Excel 中的数据链接到 Access 中，并在您使用时更新。