I want a tool (possibly VBA?) to select an existing Excel file (or even multiple Excel files from a folder at once) and put the value of fixed cells into columns of a SharePoint list (for example: put the value of A1 of the Excel file into column 1 of the Sharepoint list).
Is that even possible? And if so, would VBA be a logical option to do that?
You can use ADO for this - here's an example of adding a new record to a list.
You can get the list name if you go to the list settings and look at the URL: the list guid is after the List= querystring parameter.
https://yourCompany.sharepoint.com/sites/Site1/_layouts/15/metadatacolsettings.aspx?List={af83a2e4-a2e4-4890-1111-3431bde70e5e}
Sub SPListAdd()
Const SERVERUrl As String = "https://yourCompany.sharepoint.com/sites/Site1/"
Const ListName As String = "{af83a2e4-a2e4-4890-1111-3431bde70e5e}"
Dim Conn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim Sql As String
Dim objWksheet As Worksheet
Dim f As ADODB.Field, i As Long
Set objWksheet = ThisWorkbook.Worksheets("List Items")
objWksheet.Cells.Clear
On Error GoTo ErrHand
' Open the connection and submit the update
With Conn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;" & _
"DATABASE=" & SERVERUrl & ";" & _
"LIST=" & ListName & ";"
.Open
End With
'inserting a new record....
Sql = "SELECT * FROM [" & ListName & "] where false" 'get empty recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open Sql, Conn, adOpenKeyset, adLockOptimistic
rs.AddNew
rs.Fields("Title") = "This is a title"
rs.Update
rs.Close
'query all records for display
Sql = "SELECT * FROM [" & ListName & "]"
rs.Open Sql, Conn, adOpenStatic
If Not rs.EOF Then
For Each f In rs.Fields
objWksheet.Range("A1").Offset(0, i).Value = f.Name
i = i + 1
Next f
objWksheet.Range("A2").CopyFromRecordset rs
End If
rs.Close
Conn.Close
ErrHand:
Debug.Print Err.Number, Err.Description
End Sub
Related
So basically I would like to be able to send date from excel to access, run some queries, and send the results back to excel, and do this all from excel VBA.
I would like to send my data, which is in an excel worksheet with sheet name "Enrollment Data Aggregate" to an access database H:\My file extension\Nameofdatabase.accdb and save it as a table with the name "Enrollment Data Aggregate".
I already have queries put together that run from the table "Enrollment Data Aggregate", so I think (hope) that I can delete that table, and when I pull in the new one from excel, the queries will still update. Then I would like access to run/update the queries and export them as separate tabs to my excel file.
Ideally, I would then like to continue doing other things in excel VBA. In other words, I'm really hoping that I can control all of this from excel. I have plenty of experience with excel and access, but I've only done about 4 VBA projects that were large like this (I've done lots of small macros) so I'm not super experienced. Any suggestions would be greatly appreciated.
To export data from Excel to 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
To import data from Access to Excel:
Sub ADOImportFromAccessTable(DBFullName As String, _
TableName As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
"TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
.Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
' all records
'.Open "SELECT * FROM " & TableName & _
" WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText
' filter records
RS2WS rs, TargetRange ' write data from the recordset to the worksheet
' ' optional approach for Excel 2000 or later (RS2WS is not necessary)
' For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
' TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
' Next
' TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Running an Access Query from Excel:
Sub CreateAndRunQuery()
'------------------------------------------------------------------------------------------
'This macro opens the Sample.accdb database, creates and runs an SQL query (filtering
'all the customers from Canada). Then, it copies selected fields back in the Excel sheet.
'The code uses late binding, so no reference to external library is required.
'Written By: Christos Samaras
'Date: 05/10/2013
'Last Updated: 29/11/2014
'E-mail: xristos.samaras#gmail.com
'Site: http://www.myengineeringworld.net
'------------------------------------------------------------------------------------------
'Declaring the necessary variables.
Dim con As Object
Dim rs As Object
Dim AccessFile As String
Dim strTable As String
Dim SQL As String
Dim i As Integer
'Disable screen flickering.
Application.ScreenUpdating = False
'Specify the file path of the accdb file. You can also use the full path of the file like:
'AccessFile = "C:\Users\Christos\Desktop\Sample.accdb"
AccessFile = ThisWorkbook.Path & "\" & "Sample.accdb"
'Set the name of the table you want to retrieve the data.
strTable = "Customers"
On Error Resume Next
'Create the ADODB connection object.
Set con = CreateObject("ADODB.connection")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not created!", vbCritical, "Connection Error"
Exit Sub
End If
On Error GoTo 0
'Open the connection.
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
'Create the SQL statement to retrieve the data from table.
'Get the necessary information (first name etc.) for all the Canadian customers.
SQL = "SELECT FirstName, LastName, Address, City, Phone FROM " & strTable & " WHERE COUNTRY='Canada'"
On Error Resume Next
'Create the ADODB recordset object.
Set rs = CreateObject("ADODB.Recordset")
'Check if the object was created.
If Err.Number <> 0 Then
'Error! Release the objects and exit.
Set rs = Nothing
Set con = Nothing
'Display an error message to the user.
MsgBox "Recordset was not created!", vbCritical, "Recordset Error"
Exit Sub
End If
On Error GoTo 0
'Set thee cursor location.
rs.CursorLocation = 3 'adUseClient on early binding
rs.CursorType = 1 'adOpenKeyset on early binding
'Open the recordset.
rs.Open SQL, con
'Check if the recordet is empty.
If rs.EOF And rs.BOF Then
'Close the recordet and the connection.
rs.Close
con.Close
'Release the objects.
Set rs = Nothing
Set con = Nothing
'Enable the screen.
Application.ScreenUpdating = True
'In case of an empty recordset display an error.
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If
'Copy the recordset headers.
For i = 0 To rs.Fields.Count - 1
Sheets("New Query").Cells(1, i + 1) = rs.Fields(i).Name
Next i
'Write the query values in the sheet.
Sheets("New Query").Range("A2").CopyFromRecordset rs
'Close the recordet and the connection.
rs.Close
con.Close
'Release the objects.
Set rs = Nothing
Set con = Nothing
'Adjust the columns' width.
Sheets("New Query").Columns("A:E").AutoFit
'Enable the screen.
Application.ScreenUpdating = True
'Inform the user that the macro was executed successfully.
MsgBox "The Canadian customers were successfully retrieved from the '" & strTable & "' table!", vbInformation, "Done"
End Sub
You will find more info here.
http://www.myengineeringworld.net/2013/10/running-access-queries-from-excel-vba.html
I tried the code in this link to push and retrieved the data between Excel and Access. I modified the code based on my file path as following:
EDITED NEW CODE BLOCK
Sub UpdateMDB()
Dim accConn As Object, accRST As Object
Dim accFile As String, accStr As String
Dim lastrow As Long, i As Long
lastrow = Workbooks(1).Sheets(1).Cells(Workbooks(1).Sheets(1).Rows.Count, "A").End(xlUp).Row
accFile = "Z:\Documents\Database\Database1.mdb"
accStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & accFile & ";"
Set accConn = CreateObject("ADODB.Connection")
Set accRST = CreateObject("ADODB.Recordset")
accConn.Open accStr
accRST.Open "SELECT * FROM Table1", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
accRST.MoveFirst
Else
MsgBox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If
Do While Not accRST.EOF
For i = 1 To lastrow
If accRST!ID = Workbooks(1).Sheets(1).Range("A" & i) _
And accRST!Field1 <> Workbooks(1).Sheets(1).Range("B" & i) Then
accRST!Field1.Value = Workbooks(1).Sheets(1).Range("B" & i)
End If
Next i
accRST.Update
accRST.MoveNext
Loop
accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing
End Sub
INITIAL CODE BLOCK
Sub GetMDB()
Dim cn As Object
Dim rs As Object
strFile = "Z:\Documents\Database\Database1.mdb"
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT * FROM Table1"
rs.Open strSQL, cn
With Worksheets(1)
For i = 0 To rs.Fields.Count - 1
.Cells(1, i + 1) = rs.Fields(i).Name
Next
rs.MoveFirst
.Cells(2, 1).CopyFromRecordset rs
End With
End Sub
Sub UpdateMDB()
Dim cn As Object
Dim rs As Object
''It would probably be better to use the proper name, but this is
''convenient for notes
strFile = Workbooks(1).FullName
''Note HDR=Yes, so you can use the names in the first row of the set
''to refer to columns
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
''Selecting the cell that are different
strSQL = "SELECT * FROM [Sheet1$] s " _
& "INNER JOIN [;Database=Z:\Documents\Database\Database1.mdb;].Table1 t " _
& "ON s.id=t.id " _
& "WHERE s.Field1<>t.Field1"
rs.Open strSQL, cn, 1, 3 ''adOpenKeyset, adLockOptimistic
''Just to see
''If Not rs.EOF Then MsgBox rs.GetString
''Editing one by one (slow)
rs.MoveFirst
Do While Not rs.EOF
rs.Fields("t.Field1") = rs.Fields("s.Field1")
rs.Update
rs.MoveNext
Loop
''Batch update (faster)
strSQL = "UPDATE [;Database=Z:\Documents\Database\Database1.mdb;].Table1 t " _
& "INNER JOIN [Sheet1$] s " _
& "ON s.id=t.id " _
& "SET t.Field1=s.Field1 " _
& "WHERE s.Field1<>t.Field1 "
cn.Execute strSQL
End Sub
Reading data from Access to Excel GetMDB() macro works fine, But when I tried to update the data from Excel to Access, code gives me following error:
Run-time error '3021':
Either BOF or EOF is True, or the current record has been deleted.
Requested operation requires a current record.
I checked the mdb, xlsx and sheet path and names are correct. Anyone got a similar problem as well and how to overcome? Thanks.
You cannot run UPDATE queries using Excel workbook sources as any SQL queries using workbooks are read-only from last saved instance and cannot be updated. Excel simply is not a database to do such transactions with no record-level locking mechanism, read/write access, or relational model. Though you can run append (INSERT INTO ... SELECT *) and make-table queries (SELECT * INTO FROM ...), you cannot run UPDATE that aligns to live values.
However, you can read in an Access recordset and iterate through the Excel cells aligning by ID matches. Below assumes the Excel Sheet's ID column is in Column A and Field1 is in Column B.
Dim accConn As Object, accRST As Object
Dim accFile As String, accStr As String
Dim lastrow As Long, i As Long
Const adOpenKeyset = 1, adLockOptimistic = 3, adCmdTableDirect = 512
lastrow = Workbooks(1).Sheets(1).Cells(Workbooks(1).Sheets(1).Rows.Count, "A").End(xlUp).Row
accFile = "Z:\Documents\Database\Database1.mdb"
accStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & accFile & ";"
Set accConn = CreateObject("ADODB.Connection")
Set accRST = CreateObject("ADODB.Recordset")
accConn.Open accStr
accRST.Open "SELECT * FROM Table1", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
accRST.MoveFirst
Else
Msgbox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If
Do While Not accRST.EOF
For i = 1 to lastrow
If accRST!ID = Workbooks(1).Sheets(1).Range("A" & i) _
And accRST!Field1 <> Workbooks(1).Sheets(1).Range("B" & i) Then
accRST!Field1.Value = Workbooks(1).Sheets(1).Range("B" & i)
End If
Next i
accRST.Update
accRST.MoveNext
Loop
accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing
Notes:
If IDs between Excel worksheet and Access table are not one-to-one (i.e., Excel has multiple rows of same ID), the last Field1 value following the If logic will be inserted to corresponding Access row.
Above may be extensive processing if database rows and Excel cells are large. The best option is simply to use Access for all data entry/management and avoid the update needs. Since Excel is a flatfile, consider using it as the end use application and Access as central data repository.
I have a Userform in Excel with four textboxes. Each text box corresponds to a field of Table1 in Access.
I’m would like to return MAX row ID value from a table in Access, add 1 to that value, and to display that value in a textbox on the userform.
After I enter values into the other 3 text boxes, I would like to export data to Table1 in Access.
Can this all be accomplished in the same subroutine? Please help me incorporate sql statement in the correct location in the code.
Thank you
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim x As Long, i As Long
Dim PrimaryField As String
Dim MyTable As String
Dim GetLastPrimaryKey As Variant
PrimaryField = "ID"
MyTable = "Table1"
'Erro handler
On Error GoTo errHandler:
'dbPath = ActiveSheet.Range("H500").Value
dbPath = "H:\Annie\File.accdb"
Set cnn = New ADODB.Connection ' Initialise the collection class variable
'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
sql = "SELECT MAX([" & PrimaryField & "]) FROM [" & MyTable & "];"
'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-Microsoft.ACE.OLEDB.12.0
'Object Linking and Embedding, Database
'ADO library is equipped with a class named Recordset
Set rst = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rst.Open Source:="Table1", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'rst.Open sql, cnn
GetLastPrimaryKey = rst.Fields(0).Value
MsgBox (GetLastPrimaryKey)
GetLastPrimaryKey = Arec1.Value
'you now have the recordset object
'alternative code
With rst
.AddNew
.Fields("ID").Value = Arec1
.Fields("patient").Value = Arec2
.Fields("test").Value = Arec3
.Fields("CommentTxt").Value = Arec4
.Update
End With
'clear the userform values
For x = 1 To 4
UserForm1.Controls("Arec" & x).Value = ""
Next
'add the next user ID
'Me.Arec1 = Sheet1.Range("J3").Value
' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
'commuinicate with the user
MsgBox " The data has been successfully sent to the access database"
On Error GoTo 0
Exit Sub
errHandler:
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAdd"
End Sub
Consider opening a new recordset. Of course, change the Excel userform textbox name (placeholder here):
Set maxIDrst = New ADODB.Recordset
sql = "SELECT MAX([" & PrimaryField & "]) + 1 as MaxIDPlusOne FROM [" & MyTable & "];"
maxIDrst.Open sql, conn
UserForm1.Controls("Arec5").Value = maxIDrst!MaxIDPlusOne
maxIDrst.Close
...
Set maxIDrst = nothing
I'm very new to SQL and the whole ADO enviroment. What I'm trying to do is to see if a string is already in an ID table. The results show up just fine when I use the range.copyfromrecordset method.
But when I loop through the code I cannot find the string in the fields and rows somehow.
When using recordset.recordcount it gives -1. The String "SWED-A.ST" is in the ID table which I'm accessing and retrieving successfully, but how do I loop through the recordset and show it in the immediate window with debug.print? I've tried to loop through the fields by using a loop and movenext but only the table-heading "ID" shows up....
Code
Sub Macro1() ' Tester Sub
Dim TickerID As String: TickerID = "SWED-A.ST"
Dim SQLString As String: SQLString = "SELECT TOP 1 ID FROM Instruments WHERE ID = '" & TickerID & "'"
Dim ADODBBuilder As ADODBBuilder: Set ADODBBuilder = New ADODBBuilder
Dim RecordSet As ADODB.RecordSet: Set RecordSet = ADODBBuilder.ReturnRecordset(TickerID, , , SQLString)
Public Function ReturnRecordset(Optional TickerID As String, Optional startdate As Date, Optional enddate As Date, Optional CustomSQLString As String) As ADODB.RecordSet
Const ConnectionPath As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\name\Desktop\DataBase.accdb;Persist Security Info=False;"
Dim DataConnection As ADODB.Connection: Set DataConnection = New ADODB.Connection
Dim RecordSet As ADODB.RecordSet: Set RecordSet = New ADODB.RecordSet
DataConnection.ConnectionString = ConnectionPath
DataConnection.Open
If Len(CustomSQLString) > 0 Then
SQLString = CustomSQLString
Else
If Sheets("Mainwindow").Btn_CurrentTime.Value = True Then
SQLString = "SELECT * FROM " & TickerID _
& " WHERE [Date] BETWEEN #" & startdate & "# AND #" & enddate & "#"
Else
SQLString = "SELECT * FROM " & TickerID
End If
End If
With RecordSet
.ActiveConnection = DataConnection
.Source = SQLString
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
Set ReturnRecordset = RecordSet
'Cleanup
Set RecordSet = Nothing
Set DataConnection = Nothing
End Function
The default ADO .Open uses an adOpenForwardOnly cursor that always returns a .RecordCount of -1. You are also specifying adOpenForwardOnly in the recordset properties. You need to change it to adOpenStatic or adOpenKeyset to get an accurate record count returned.
DataConnection.Open, adOpenStatic
···
With RecordSet
.ActiveConnection = DataConnection
.Source = SQLString
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
End With
Consider that I have an Excel workbook and an Access table not necessarily having a similar structure (i.e. they may not have same number of columns).
When I open the workbook the rows in the Excel sheet get populated by the rows in Access table (copied from the Access table into the Excel sheet's particular range of cells specified using macros).
Then I modify certain cells in the Excel sheet.
I also have a button called "Save" in the Excel sheet. When pressed, this will execute a macro.
My question: how can I update the Access table to reflect the changes in the Excel sheet when the "Save" button is clicked?
You can use ADO and some code.
Here are some notes.
Let us say you get some data like so:
Sub GetMDB()
Dim cn As Object
Dim rs As Object
strFile = "C:\Docs\DBFrom.mdb"
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT * FROM Table1"
rs.Open strSQL, cn
With Worksheets(7)
For i = 0 To rs.Fields.Count - 1
.Cells(1, i + 1) = rs.Fields(i).Name
Next
rs.MoveFirst
.Cells(2, 1).CopyFromRecordset rs
End With
End Sub
You could update the data using ADO like so:
Sub UpdateMDB()
Dim cn As Object
Dim rs As Object
''It wuld probably be better to use the proper name, but this is
''convenient for notes
strFile = Workbooks(1).FullName
''Note HDR=Yes, so you can use the names in the first row of the set
''to refer to columns
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
''Selecting the cell that are different
strSQL = "SELECT * FROM [Sheet7$] s " _
& "INNER JOIN [;Database=c:\Docs\DBFrom.mdb;].Table1 t " _
& "ON s.id=t.id " _
& "WHERE s.Field1<>t.Field1"
rs.Open strSQL, cn, 1, 3 ''adOpenKeyset, adLockOptimistic
''Just to see
''If Not rs.EOF Then MsgBox rs.GetString
''Editing one by one (slow)
rs.MoveFirst
Do While Not rs.EOF
rs.Fields("t.Field1") = rs.Fields("s.Field1")
rs.Update
rs.MoveNext
Loop
''Batch update (faster)
strSQL = "UPDATE [;Database=c:\Docs\DBFrom.mdb;].Table1 t " _
& "INNER JOIN [Sheet7$] s " _
& "ON s.id=t.id " _
& "SET t.Field1=s.Field1 " _
& "WHERE s.Field1<>t.Field1 "
cn.Execute strSQL
End Sub