I'm a creating a vba macro for an Excel database. The database is about a number of people and the time spent by them on each of their projects. Whenever there's a new user, a new column adds up.
So, I tried with rs.Fields.Append but it's not working. :( can you help me?
Sub AjoutEnregistrement()
Dim cnn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim Project As String
Dim MyCheck As Boolean
Set cnn = New ADODB.Connection
Dim i As Variant
MyFile = "D:\Users\X\Documents\Checkin__2018.xlsm"
LoginID = "A01825112"
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
Fichier & ";Extended Properties='Excel 12.0;HDR=No'"
Set rs = New ADODB.Recordset
rs.Open "SELECT * from [AUGUST$] ", cnn, adOpenDynamic, adLockOptimistic
rs.Fields.Append "LoginID"
rs.AddNew
rs.Update
rs.Close
cnn.Close
End Sub
Excel isn't a database, and you're not meant to interact with it this way. ADODB recordsets let you read/write recordsets to/from Excel, but they're not meant to be updated by VBA; as far as I know, what you're trying to do here isn't possible. It really sounds like Access would serve your needs far better than Excel would.
If you must use Excel, you should just do what you're trying to do directly. That is, add a column to a spreadsheet.
You can use the following sub to do so, given a worksheet and the header of the new column
Sub addHeader(ws As Worksheet, newColHeader As String)
Dim lastCol As Long
lastCol = ws.Cells(1, ws.columns.Count).End(xlToLeft).column
ws.Cells(1, lastCol + 1).Value = newColHeader
End Sub
In your example, you would call it with
addHeader Workbooks("Checkin__2018.xlsm").Worksheets("AUGUST$"), LoginID
You cannot add a column to an ADODB RecordSet after the RecordSet has been opened. Josh's answer is good - add the column in Excel and re-query.
Related
I've found lots of posts on this problem, but so far no solutions have helped.
I'd like to read and write data from/to an Excel worksheet from an external VBA application - so far it reads OK, but I get an error while trying to write values to the ADODB Recordset.
Here's the code:
Sub UpdateFromExcel()
'https://stackoverflow.com/questions/15620080/reading-data-using-oledb-from-opened-excel-file
Dim oConn As New ADODB.Connection
Dim oRS As New ADODB.Recordset
Dim sPath
Dim sSQL As String
sSQL = "SELECT * FROM [Sheet1$A1:N10000]"
sPath = frmExcelSync.txtFilePath
oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & sPath & "';" & _
"Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
oRS.Open sSQL, oConn, adOpenDynamic, adLockOptimistic
Do While Not oRS.EOF
'ITERATE THROUGH EACH ROW HERE
'ADD CODE ABOVE
'****GET AN ERROR HERE:****
oRS.Update "Occurrence Name", "Test"
oRS.MoveNext
Loop
oRS.Close
oConn.Close
End Sub
The error is
"Cannot update. Database or object is read-only".
I've tried different lock and cursor types, and I've tried editing the fields then using the .update method, but nothing has worked so far.
Any suggestions?
your update statement is not correct. I believe you want to update the column "Occurrence Name" with the value "Test"
What you should write is.
Do While Not oRS.EOF
oRS![Occurrence Name].value = "Test"
oRS.MoveNext
Loop
oRS.Update
The problem seems to have gone away somehow.
I tried a few different things (different spreadsheets) with mixed success then restarted the application - now it works.
No code changes at all.
new at vba. I have an Access database that updates an excel workbook. What I have so far it that is appends the set of records to the bottom of a data tab.
What I need to build is that before it appends the data I need for VBA to check the workbook for today's date in the Date column on the data tab. If it finds today's date, it shouldn't append the data.
I know i need to either max(date column) or DMax but I am lost on how to build this.
completely confused myself, so instead of getting more in the weeds I am asking for help.
Public Sub max_Click()
verintreportTemplate2 = "Template_VerintSchedulesResults_EST.xlsx"
reporttemplatelocation = "\Customer Service\Midwest\OH Group01\EntSchedAndForecast\BackUpDocs\NEW_DATABASE\Schedules_Process\Report_Templates\"
Drive = "z:"
Dim appExcel As Object
Set appExcel = CreateObject("Excel.Application")
With .Workbooks.Open(Drive & reporttemplatelocation & verintreportTemplate2)
.Worksheets ("DOW Summary Data")
'dateMax = DMax("Weekof")
so I stopped at this point.
If workbook structure is simple (single row column headers in first row), open a recordset using worksheet as data source. If worksheet has a complicated structure, specify a range or different approach will be needed.
Grab date value from record.
Public Sub max_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
verintreportTemplate2 = "Template_VerintSchedulesResults_EST.xlsx"
reporttemplatelocation = "\Customer Service\Midwest\OH Group01\EntSchedAndForecast\BackUpDocs\NEW_DATABASE\Schedules_Process\Report_Templates\"
Drive = "z:"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Drive & reporttemplatelocation & verintreportTemplate2 _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
rs.Open "SELECT Max(Weekof) AS MaxDate FROM [DOW Summary Data$]", cn, adOpenDynamic, adLockOptimistic
If Date() <> rs!MaxDate Then
'do something
End If
End Sub
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.
I have a database with different values. It is object based, so object "A" will have certain data and so on for other objects. It has almost 200,000 lines, but I only need the data from one object that is given as input in my tool's database. I want my tool to look in the huge database and pull the required data into its own database.
This huge database is also in the same workbook of my tool, but it has to be updated regularly and makes my tool open too slowly. I want the database in a different workbook, and the required data to be copied, according to an input object, into a sheet of my tool, where I will work on it.
Suppose the huge database (let's call it Workbook A) is as follows:
object var1 var2 var3 var4 var5
A
B
C
D
E
Input workbook is B
sheet 1 where we give input
lets say input is A
The input database is in Sheet2:
object var1 var2 var3 var4 var5
A
You can either use VLOOKUP and reference your other workbook or you can use VBA and ADO to access the data. The VBA ADO method is shown below. You must set a reference to Microsoft ActiveX Data Objects.
Dim DBWorkbook As String
Dim rs As ADODB.Recordset
Dim con As New ADODB.Connection
Dim wb As Workbook
Dim ws As Worksheet
Sub get_data() 'set reference to Microsoft ActiveX Data Objects
Set wb = ThisWorkbook
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
DBWorkbook = "C:\MyHugeDatabaseWorkbook.xlsx"
'lets assume everything is happening on Sheet2, Row2
Set ws = wb.Sheets("Sheet2")
LookupObject = ws.Cells(2, 1)
'connect to huge database workbook
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBWorkbook & ";Extended Properties=""Excel 8.0;"""
'get data for object
rs.Open "Select * from [Sheet1$] WHERE [object]='" & LookupObject & "'", con, adOpenStatic
'fill in sheet with data, if it exists in the database worksheet
If Not rs.EOF Then
ws.Cells(2, 2) = rs("var1")
ws.Cells(2, 3) = rs("var2")
ws.Cells(2, 4) = rs("var3")
ws.Cells(2, 5) = rs("var4")
ws.Cells(2, 6) = rs("var5")
End If
'cleanup
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
'this needs error trapping once you have it working
End Sub
You would also do yourself a huge favor by putting your database into Access or SQL Server and referencing it from there.
I am working on an Excel application that queries a SQL database. The queries can take a long time to run (20-40 min). If I've miss-coded something it can take a long time to error or reach a break point. I can save the results to a sheet fine, it's when I am working with the record sets that things can blow up.
Is there a way to load the data into a ADODB.Recordset when I'm debugging to skip querying the database (after the first time)?
Would I use something like this?
Query Excel worksheet in MS-Access VBA (using ADODB recordset)
I had to install the MDAC to get the msado15.dll and once I had it I added a reference to it from (on Win7 64bit):
C:\Program Files (x86)\Common Files\System\ado\msado15.dll
Then I created a function to return an ADODB.Recordset object by passing in a sheet name that exists in the currently active workbook. Here's the code for any others if they need it, including a Test() Sub to see if it works:
Public Function RecordSetFromSheet(sheetName As String)
Dim rst As New ADODB.Recordset
Dim cnx As New ADODB.Connection
Dim cmd As New ADODB.Command
'setup the connection
'[HDR=Yes] means the Field names are in the first row
With cnx
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source='" & ThisWorkbook.FullName & "'; " & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
.Open
End With
'setup the command
Set cmd.ActiveConnection = cnx
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT * FROM [" & sheetName & "$]"
rst.CursorLocation = adUseClient
rst.CursorType = adOpenDynamic
rst.LockType = adLockOptimistic
'open the connection
rst.Open cmd
'disconnect the recordset
Set rst.ActiveConnection = Nothing
'cleanup
If CBool(cmd.State And adStateOpen) = True Then
Set cmd = Nothing
End If
If CBool(cnx.State And adStateOpen) = True Then cnx.Close
Set cnx = Nothing
'"return" the recordset object
Set RecordSetFromSheet = rst
End Function
Public Sub Test()
Dim rstData As ADODB.Recordset
Set rstData = RecordSetFromSheet("Sheet1")
Sheets("Sheet2").Range("A1").CopyFromRecordset rstData
End Sub
The Sheet1 data:
Field1 Field2 Field3
Red A 1
Blue B 2
Green C 3
What should be copied to Sheet2:
Red A 1
Blue B 2
Green C 3
This is saving me a HUGE amount of time from querying against SQL every time I want to make a change and test it out...
--Robert
Easiest would be to use rs.Save "filename" and rs.Open "filename" to serialize client-side recordsets to files.
Another alternative to get a Recordset from a Range would be to create and XMLDocument from the target Range and open the Recordset from that document using the Range.Value() property.
' Creates XML document from the target range and then opens a recordset from the XML doc.
' #ref Microsoft ActiveX Data Objects 6.1 Library
' #ref Microsoft XML, v6.0
Public Function RecordsetFromRange(ByRef target As Range) As Recordset
' Create XML Document from the target range.
Dim doc As MSXML2.DOMDocument
Set doc = New MSXML2.DOMDocument
doc.LoadXML target.Value(xlRangeValueMSPersistXML)
' Open the recordset from the XML Doc.
Set RecordsetFromRange = New ADODB.Recordset
RecordsetFromRange.Open doc
End Function
Make sure to set a reference to both Microsoft ActiveX Data Objects 6.1 Library and Microsoft XML, v6.0 if you want to use the example above. You could also change this function to late binding if so desired.
Example call
' Sample of using `RecordsetFromRange`
' #author Robert Todar <robert#roberttodar.com>
Private Sub testRecordsetFromRange()
' Test call to get rs from Range.
Dim rs As Recordset
Set rs = RecordsetFromRange(Range("A1").CurrentRegion)
' Loop all rows in the recordset
rs.MoveFirst
Do While Not rs.EOF And Not rs.BOF
' Sample if the fields `Name` and `ID` existed in the rs.
' Debug.Print rs.Fields("Name"), rs.Fields("ID")
' Move to the next row in the recordset
rs.MoveNext
Loop
End Sub