Question

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

到目前为止的代码：

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

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

打开MS Access
创建新的空白数据库（在此步骤中，您必须为数据库命名，并设置保存位置）
在“外部数据”选项卡上的新数据库中，根据要导入的内容选择要添加的正确类型（在这种情况下，您必须选择Excel）
- 在早期的MS Access版本中，流行的可插入事物被拉伸
- 在2016版本中，O365的选项更为紧凑，因此有一个名为“新数据源”的选项，其中包含所有可能性
导入进度包括几个步骤。
1. 您必须选择源并设置要导入数据的方式。您可以将数据作为副本导入到Access中的新表中，也可以将数据源连接到Access数据库。选择连接源数据以进行实时通信。
2. 选择内部数据源（例如，要导入的工作表或范围）
3. 设置第一行是否包含标题
4. 为链接表命名

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

如何将Excel电子表格传输到Access数据库

2 个答案: