Overwrite access database from excel table using VBA - excel

I've searched this website for my question, but unable to locate solution.
I'm a beginner for excel VBA, Need some help help in updating old data in access database with new data from excel spreadsheet using excel-VBA.
From internet i've created the following steps.
Step1 : Uploading initial data (I've got a working VBA macro for this step):
Upload excel table:
Step 2 : Downloading data from access to excel (I've working VBA macro for this step)
Download from access:
Step 3 : Now, I want to overwrite entire access table with revised data from excel table. I'm unable to locate macro for this step.
Overwrite from excel to access:
Please help me with a VBA program or any website link for this step.
I'm unable to attach the excel sheet here.

Finally found macro from other source, sharing the code for any other beginner
Sub Modify()
Dim dbs As ADODB.Connection
Dim rset1 As ADODB.Recordset
Dim sql As String
Dim ws As Worksheet
Dim lr As Long
Dim FName As String
Dim i As Long, j As Integer
FName = "C:\Users\temp\Database - Copy.accdb" 'change as needed
Set dbs = New ADODB.Connection
dbs.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & FName
Set rset1 = New ADODB.Recordset: rset1.CursorLocation = adUseClient
Set ws = Worksheets("Import") 'update sheet name as needed.
lr = ws.Range("B" & Rows.Count).End(xlUp).Row
For i = 10 To lr
rset1.Open "SELECT * FROM [DB] WHERE [ID] = " & ws.Range("B" & i).Value, dbs, , adLockOptimistic
With rset1
For j = 1 To rset1.Fields.Count - 1
.Fields(j).Value = ws.Range("B" & i).Offset(0, j).Value
Next j
.Update
.Close
End With
Next i
Set rset1 = Nothing
dbs.Close: Set dbs = Nothing
End Sub

Related

How can I get the value from a cell in other workbooks based on dynamic file path

I would like to get the cell value from other workbooks to my master file.
Those files are in the same folder G:\Data\xxx\yyy while the file name is customer ID.
I.e. the file path could be G:\Data\xxx\yyy\123 or G:\Data\xxx\yyy\234
And the value I would like to extract from those workbooks is in Sheet ABC cell J55.
So the formula I input in the cell is = G:\Data\xxx\yyy [123.xlsm]'!$J$55
In the master file, I have a list of customer ID in Column A and I would like to get the value from cell J55 in other workbooks. i.e. create a dynamic file path to get the numbers and paste it to column B.
However, I tried to combine the link with the “CONCATENATE” and “G” but didn’t work out.
I tried the indirect function but it requires me to open the referencing workbooks that is not ideal.
Is that a way for me to get the numbers?
VBA coding is welcome.
This is a solution that can be run from Excel VBA. I admit it might be overkill to solving your issue but it will check column A for values and fill column B if it is blank from J55 of the selected workbooks without opening any of them.
It assumes you have Microsoft Access as part of your office suite, are running on a 64 bit version of Windows, the files your are retrieving data from have a .xlsx extension and the data you want from J55 is on "Sheet1". If any of these assumptions are incorrect please let me know as the code can be easily adjust to accommodate.
From the information you have provided it seems that the file path for all the files you would like to access are static (G:\Data\xxx\yyy) and only the file name is dynamic (file name = Customer ID # from column A). You will need to make a reference to Microsoft XML v6.0 and Microsoft ActiveX Data Objects x.x Library.
The code below is mostly cut and pasted from another project I wrote. It does still need to be tested. I would advise adding some error handling and the normal performance enhancing vba code like turning off screen updating.
Option Explicit
Public Sub Test()
'Folder where Wb live
Const FilePath As String = "G:\Data\xxx\yyy\"
'Command string
Const request_SQL As String = "SELECT * FROM [Sheet1$]"
'Get last row
Dim LastRow As Long
With ActiveWorkbook.ActiveSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
'Create Array from Main worksheet
Dim MainWsArray As Variant
MainWsArray = ActiveWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 2))
Dim FullFileName As String
'Create a connection to be used throughout the loop
Dim Cnx As ADODB.Connection
Set Cnx = New ADODB.Connection
Dim CustomerId As Long
Dim RowCounter As Long
Dim Rst As ADODB.Recordset
Set Rst = New ADODB.Recordset
'Loop through Array to get values
For RowCounter = 1 To LastRow
If MainWsArray(2, RowCounter) = vbNullString Then
CustomerId = MainWsArray(1, RowCounter).Value
FullFileName = FilePath & CustomerId
AssignCnx Cnx, FullFileName
'Create RecordSet
If OpenRecordset(Rst, request_SQL, Cnx) Then
MsgBox "Unable to open Recordset. " & CustomerId
End If
'Use recordset to get data from file.
Rst.Move 54
MainWsArray(2, RowCounter) = Rst.Fields(10)
End If
Rst.Close
Cnx.Close
Next RowCounter
ActiveWorkbook.ActiveSheet.Range(Cells(1, 2), Cells(LastRow, 2)) = MainWsArray()
If Not Rst Is Nothing Then Set Rst = Nothing
If Not Cnx Is Nothing Then Set Cnx = Nothing
End Sub
Public Sub AssignCnx(ByRef Cnx As ADODB.Connection, ByVal FullFileName As String)
'Connection
With Cnx
.Provider = "Microsoft.ACE.OLEDB.12.0" 'or "Microsoft.Jet.OLEDB.4.0" for 32bit
.ConnectionString = "Data Source=" & FullFileName & _
";Extended Properties='Excel 12.0 xml;HDR=NO;IMEX=1;Readonly=False'"
.Open
End With
End Sub
Private Function OpenRecordset(ByRef Rst As ADODB.Recordset, ByVal request_SQL As String, ByRef Cnx As ADODB.Connection) As Boolean
'Error Trapping for the RecordSet
Dim backupRequestString As String
On Error Resume Next
Rst.Open request_SQL, Cnx, adOpenForwardOnly, adLockReadOnly, adCmdText
If Err.Number = 0 Then
OpenRecordset = False
Exit Function
Else
Rst.Close
OpenRecordset = True
Exit Function
End If
End Function
I hope you find this helpful. If it is a bit much there are other ways to link workbooks to the master file from within Excel w/o VBA. It's been a long time since I have done it that way though. Best of luck.

How to transfer an excel spreadsheet to an access database

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
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
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.
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.

return a list of all access (.mdb) tables with an excel macro

I have an mdb file location defined in Sheet1 range B1. This value is:
"C:\Users\User\Desktop\Test.mdb"
What I am looking to do is generate a list of all the tables in this file and return it within excel. I have a partially working script but it is returning unwanted items
I am working off of this:
Sub GetTableNames()
Dim cnn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim lRow As Long
Dim szConnect As String
LastRowSetup = Worksheets("Setup").Cells(Rows.Count, 1).End(xlUp).Row 'last row where table names populate
If LastRowSetup < 10 Then
LastRowSetup = 10 'so we dont accidentally clear important data above this
End If
Sheets("Setup").Range("A10:A" & LastRowSetup & "").ClearContents 'clear old data
fStr = Sheets("Setup").Range("C2").Value 'file location of mdb
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fStr & ";"
Set cnn = New ADODB.Connection
cnn.Open szConnect
Set cat = New ADOX.Catalog
Set cat.ActiveConnection = cnn
lRow = 10
For Each tbl In cat.Tables
Sheet1.Cells(lRow, 1).Value = tbl.Name
lRow = lRow + 1
Next tbl
cnn.Close
Set cat = Nothing
Set cnn = Nothing
End Sub
however it is returning many additional things that are NOT table names. for instance
~TMPCLP313341
~TMPCLP74661
Approved_table1
Approved_table2
MSysAccessStorage
MSysAccessXML
MSysACEs
MSysNameMap
MSysNavPaneGroupCategories
MSysNavPaneGroups
MSysNavPaneGroupToObjects
MSysNavPaneObjectIDs
MSysObjects
MSysQueries
MSysRelationships
when i physically open the mdb all i see are 'table 1' and 'table 2'. is there a way to implement an additional filter in the ADODB connection to not return all of the temp files and Msys objects or is this something i will just have to filter after importing.
note that i had to set a reference to the Microsoft
ADO Ext. 2.X for DDL and Security object library as well as the normal ADO
object library.
try this code:
For Each tbl In cat.Tables
If Left(tbl.Name, 4) <> "MSys" And Left(tbl.Name, 1) <> "~" then
Sheet1.Cells(lRow, 1).Value = tbl.Name
lRow = lRow + 1
end if
Next tbl
is there a way to implement an additional filter in the ADODB connection to not return all of the temp files and Msys objects or is this something i will just have to filter after importing.
No, you will have to loop through the table names and simply ignore the system ("MSys...") and temporary ("~...") tables.

How to query access and link it to a sheet in excel

I'm working on a project where and I've hit a road block. I have a table in excel, I'd like to run a query by linking tables in access to a worksheet in the excel and then store the report into an excel sheet. I'm close where I can run access queries and store in excel from tables already existing in access, but I can't figure out how to to do it if one of the tables is instead in my excel sheet. Does anybody have know the vba code to link access tables to an excel worksheet?
I'm referencing the following link which gets me really close but not all the way.
http://www.myengineeringworld.net/2013/10/running-access-queries-from-excel-vba.html
http://www.globaliconnect.com/excel/index.php?option=com_content&view=article&id=173:import-export-data-from-access-to-excel-using-ado&catid=79&Itemid=475
Private Sub CommandButton1_Click()
'--------------
'DIM STATEMENTS
Dim strMyPath As String, strDBName As String, strDB As String, strSQL As String
Dim i As Long, n As Long, lastRow As Long, lFieldCount As Long
'instantiate an ADO object using Dim with the New keyword:
Dim adoRecSet As New ADODB.Recordset
Dim connDB As New ADODB.Connection
'--------------
'THE CONNECTION OBJECT
strDBName = "REPORT.MDB"
strMyPath = "C:\Program Files\SETROUTE 9.2.0\DATA"
strDB = strMyPath & "\" & strDBName
'Connect to a data source:
'For pre - MS Access 2007, .mdb files (viz. MS Access 97 up to MS Access 2003), use the Jet provider: "Microsoft.Jet.OLEDB.4.0". For Access 2007 (.accdb database) use the ACE Provider: "Microsoft.ACE.OLEDB.12.0". The ACE Provider can be used for both the Access .mdb & .accdb files.
connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB
'--------------
'OPEN RECORDSET, ACCESS RECORDS AND FIELDS
Dim ws As Worksheet
'set the worksheet:
Set ws = ActiveWorkbook.Sheets("Cables721")
'Set the ADO Recordset object:
Set adoRecSet = New ADODB.Recordset
'Opening the table named SalesManager:
strTable = "Cables with Incomplete Vias"
adoRecSet.Open "", Source:=strTable, ActiveConnection:=connDB, CursorType:=adOpenStatic, LockType:=adLockOptimistic
'--------------
'COPY RECORDS FROM THE EXCEL WORKSHEET:
'Note: Columns and their order should be the same in both Excel worksheet and in Access database table
lFieldCount = adoRecSet.Fields.Count
'determine last data row in the worksheet:
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'start copying from second row of worksheet, first row contains field names:
For i = 2 To lastRow
adoRecSet.AddNew
For n = 0 To lFieldCount - 1
adoRecSet.Fields(n).Value = ws.Cells(i, n + 1)
Next n
adoRecSet.Update
Next i
'--------------
'close the objects
adoRecSet.Close
connDB.Close
'destroy the variables
Set adoRecSet = Nothing
Set connDB = Nothing
End Sub
Try using Connection String :
Sub Button1_Click()
Dim cn As Object
Dim rs As Object
Dim strSql As String
Dim strConnection As String
Set cn = CreateObject("ADODB.Connection")
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Documents and Settings\XXXXXX\My Documents\my_access_table.accdb"
strSql = "SELECT Count(*) FROM mytable;"
cn.Open strConnection
Set rs = cn.Execute(strSql)
MsgBox rs.Fields(0) & " rows in MyTable"
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
The Provider piece must be Provider=Microsoft.ACE.OLEDB.12.0 if your target database is ACCDB format. Provider=Microsoft.Jet.OLEDB.4.0 only works for the older MDB format.
Also refer to : How to query a MS-Access Table from MS-Excel (2010) using VBA
Also you can manually add the table as connection from excel - under Data Tab

Export Access Table to dBase file from Excel VBA?

I have an Excel "Application" where users add/edit/etc. data. When ready, they export this data, the final deliverable needing to be a dBase file. Since Excel 2007 no longer has the Save As dBase feature, I've created the following code to export my data to an Access Table.
Is there any way in my VBA in Excel to go ahead and transfer the Access Table then into a dBase file? Or do I need to do that step from Access itself?
I'm trying to keep everything in Excel to make future modification as easy as possible. Any help is appreciated. If possible, would even be fine with doing from Access if the process can be automated in-sync with my Export process.
Sub Export()
Dim dbConnection As ADODB.Connection
Dim dbFileName As String
Dim dbRecordset As ADODB.Recordset
Dim xRow As Long, xColumn As Long
Dim LastRow As Long
'Go to the worksheet containing the records you want to transfer.
Worksheets("FeedSamples").Activate
'Determine the last row of data based on column A.
LastRow = Cells(Rows.Count, 1).End(xlUp).row
'Create the connection to the database.
Set dbConnection = New ADODB.Connection
'Define the database file name
dbFileName = "\\agfiles\public\ITSD_ApDev\James Scurlock\Personal Project Notes\FeedSampleResults.accdb"
'Define the Provider and open the connection.
With dbConnection
.Provider = "Microsoft.ACE.OLEDB.12.0;Data Source=" & dbFileName & _
";Persist Security Info=False;"
.Open dbFileName
End With
'Create the recordset
Set dbRecordset = New ADODB.Recordset
dbRecordset.CursorLocation = adUseServer
dbRecordset.Open Source:="ImportedData", _
ActiveConnection:=dbConnection, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable
'Loop thru rows & columns to load records from Excel to Access.
'Assume row 1 is the header row, so start at row 2.
'ACCESS COLUMNS MUST BE NAMED EXACTLY THE SAME AS EXCEL COLUMNS
For xRow = 2 To LastRow
dbRecordset.AddNew
'Assume this is an 8-column (field) table starting with column A.
For xColumn = 1 To 69
dbRecordset(Cells(1, xColumn).value) = Cells(xRow, xColumn).value
Next xColumn
dbRecordset.Update
Next xRow
'Close the connections.
dbRecordset.Close
dbConnection.Close
'Release Object variable memory.
Set dbRecordset = Nothing
Set dbConnection = Nothing
'Optional:
'Clear the range of data (the records) you just transferred.
'Range("A2:H" & LastRow).ClearContents
MsgBox "Test"
Dim access As access.Application
Set access = "\\agfiles\public\ITSD_ApDev\James Scurlock\Personal Project Notes\FeedSampleResults.accdb"
access.DoCmd.OpenTable "ImportedData"
access.DoCmd.TransferDatabase acExport, "dBASE IV", "C:\", acTable, "ImportedData", "TEST.DBF"
DoCmd.Close acTable, "ImportedData"
'CREATE dBASE FILE!
End Sub
You could connect to the target Dbase IV file through ADO: ADO.NET OleDB and very old dBASE IV file
Once you have a connection to Dbase IV, you can use the same code that you use to load data from excel to access to load the data into Dbase IV instead.

Resources