How to transfer an excel spreadsheet to an access database - excel

Question

I'm making a program to track my weight, calories I eat in a day, and the date, to help me lose weight. I'm manually putting in these values into a spreadsheet with those three columns (date, calories, weight). I want to transfer the information in these three columns into an access database.
Code so far:
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
So far my code is only starting the connection between access and excel

Answer 1

There are many ways to do this. Let's look at a couple of case studies.
Export data from Excel to Access (ADO)
If you want to export data to an Access table from an Excel worksheet, the macro example below shows how this can be done.
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
Also . . .
Export data from Excel to Access (DAO)
If you want to export data to an Access table from an Excel worksheet, the macro example below illustrates another way to do this.
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
Also . . .
Browse to a single EXCEL File and Import Data from that EXCEL File via TransferSpreadsheet (VBA)
Here's yet another way . . .
Sub 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

I know this looks like a dead thread but I wanted to revive for Office 360 users. I had to compile an answer from several sources to make something workable. See below.
First- note that you need at least the 2 following references active in your Tools>References Menu.
Microsoft Access 16.0 Object Library &
Microsoft Office 16.0 Access Database Engine Object
You may also need to have:
Visual Basic for Applications//
Microsoft Excel 16.0 Object Library//
OLE Automation//
Microsoft Forms 2.0 Object Library//
Microsoft Outlook 16.0 Object Library//
Microsoft Office 16.0 Object Library
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's second DAO option is basically what this code is as well. I included the references and gave some extra options for you to see some more examples.

Answer 3

Creat a stand alone Acces DB then link the Excel in it. The Access has tools to import data from Excel with live communication.
Follow this:
Open MS Access
Creat new blank database (in this step you have to give name to the database, and set the save location)
In the new database on External Data tab choose the correct type to add based on what you want to import (in this case you have to select Excel)
in the earlier MS Access version the popular insertable things were stretched
in the 2016 version, and O365 the options is more compact so there is one option called New Data Source which contain all possibilities
The import progress consits of several steps.
you have to select the source and set how you want to import data. You can import data into a new table in Access as a copy, or you can connect the source of data to the Access database. Select connect source data for live communication.
select inner data source (for example which sheet, or range you want to import)
set if the first row contain headers
give a name to the linked table
Finally data from Excel linked into Access and it will update when you use it.