Selectively Update or Create New Records in Access From Excel 2

[LevelThought]

I continue to receive a "automation error" (Run-time error - 2147217843 (80040e4d)) upon trying to selectively create new records or update existing records in an Access table from an Excel Worksheet using the following code:

Sub CompleteDataToAccessAug2()
Dim ADOC As New ADODB.Connection
Dim DBS As New ADODB.Recordset
ADOC.Open "Provider=Microsoft.Jet.oledb.4.0;" & _
"Data Source=C:\Access Databases\TestReport.mdb;"
DBS.Open "tblVariance", ADOC, adOpenKeyset, adLockOptimistic, adCmdTable
Sheets("Data").Activate
Range("A2").Select
On Error GoTo CompleteDataToAccess_err
Do Until ActiveCell.Value = ""
With DBS
strSQL = "select * from tblVariance where AcctNo=" & ActiveCell.Range("Acct") & ""

On Error Resume Next
.Open strSQL, cn, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo 0
If .State = adStateOpen Then ' successfully opened the recordset
If .EOF Then ' no records returned
DBS.AddNew ' create a new record
DBS!ContractOrig = ActiveCell.Value
DBS!ReviewOrig = ActiveCell.Offset(0, 1).Value
DBS!AcctNo = ActiveCell.Offset(0, 2).Value
DBS.Update ' stores the new record
ActiveCell.Offset(1, 0).Select

Else
DBS!ReviewCurrent = ActiveCell.Offset(0, 3).Value
DBS!ExpPymtCurrent = ActiveCell.Offset(0, 4).Value
DBS!DateUpdated = Now()
DBS.Update ' stores the new record
ActiveCell.Offset(1, 0).Select
End If
End If
End With
Loop
CompleteDataToAccess_exit:
DBS.Close
ADOC.Close
Set ADOC = Nothing
Set DBS = Nothing
Exit Sub
CompleteDataToAccess_err:
MsgBox "Sorry - an error occurred..." & vbCrLf & "Number: " & Err.Number & _
vbCrLf & "Description: " & Err.Description
Resume CompleteDataToAccess_exit
End Sub

Any insight as to a resolution.

Basically, using this approach to the updating of calculated fields within my Access table on a daily basis.

Thanks in advance.

 

[RoyVidar]

Which line? Any records getting updated/added at all?

Your DBS recordset is opened prior to the loop, but not closed prior to the first opening within the loop.

But - my first guess would be some of the lines prior to invoking any errorhandling at all, opening the connection, and the DBS recordset the first time, perhaps have a look at Connection strings for Jet (check the .state property of the connection, too)

- and - storing calculated value that can be derived from other fields, may prove to provide more work (and headaches) than using a normalized structure and calculate...

Roy-Vidar

 

[JerryKlmns]

LevelThought

you open the recordset in this line

DBS.Open "tblVariance", ADOC, adOpenKeyset, adLockOptimistic, adCmdTable

and few lines below you re-open it using a different connection
.Open strSQL, cn, adOpenKeyset, adLockOptimistic, adCmdText

........

You should filter it like

With DBS
.Filter = "AcctNo=" & ActiveCell.Range("Acct")

and check

if .eof and .bof then ' no records at all
.AddNew ' create a new record
.Field("ContractOrig") = ActiveCell.Value
.Field("ReviewOrig") = ActiveCell.Offset(0, 1).Value
.Field("AcctNo") = ActiveCell.Offset(0, 2).Value
.Update ' stores the new record
ActiveCell.Offset(1, 0).Select
else
.Field("ReviewCurrent") = ActiveCell.Offset(0, 3).Value
.Field("ExpPymtCurrent") = ActiveCell.Offset(0, 4).Value
.Field("DateUpdated") = Now()
.Update ' stores the updates
ActiveCell.Offset(1, 0).Select
End If
End With

 

[LevelThought]

Should one of the "open" statements be deleted?

I thought that more than one recordset could be open at the same time using one connection.

I have created a range name on the Excel worksheet named "Acct" and comparing each account number within this range with the account number within my local Access table.

What specific modifications should be made?

Initially, I had considered the following steps to update the calculated fields within my local Access table:

Create a Access query to pull the individual components of the calculated formula

Bind the query to a form and then, create the textboxes for the calculated fields

Using the after update event for the text box controls on the form update the calculate fields on the form

Use the after update event for the form to update the table on a daily basis



However, performing the query in Hyperion(Brio) and then extracting the results to Excel appeared to be the ideal way to update the calculated fields.

 

[JerryKlmns]

LevelThought,

Yes you may open more than one recordsets over the same connection. But you tried to open the recordset object DBS twice (as Roy spoted you should first close it and the reuse it).

My suggestion uses the firstly opened recordset filtering it for every value of your excel range. If the filtered recordset contains no records then add one record, else update the filtered record. I hope you get one and only one record. If you get more than one, you should loop all filtered records and update them.

 

[LevelThought]

The "Automation Error" persists!

Does anyone know how the module that was initially posted on August 2, 2005 should be modified to allow "new" records to be created in the local access table or an update of fields on certain pre-existing records?

Daily, I create a query of an Oracle database,using Hyperion(Brio) and "pull" several hundred records that were updated on 3 separate tables within the Oracle database. Specifically, the date that the records were updated is recorded in the field titled "Date Updated."

As a novice in the use of recordsets and ADO, I am at a standstill!


Thanks in advance.

 

[RoyVidar]

We are probably at a stand still too, as
1 - you have not answered any of the questions we have asked
2 - nor can we find any trace of trying our suggestions
3 - we don't see your current code
4 - no - this site isn't primarly decided for us to do full code solutions, but discussion about why things are not working, suggestions of improvement, highligting problems etc - the reason we ask questions, is to provide better assistance.

So re 1
Again - which line bombs
Again - is the connection OK (state property, using correct connection for all opening)
Again - do you now use the same connection both places
Again - do you now close the recordset prior to reopening it
Again - does anything get updated/appended at all

For the connection thingies,as JerryKlmns stated, either open the table and do the filter thingies (then don't reopen the recordset within the loop), or just drop opening the table entirely, and do the recordsetopening based on the where clause)

Remove the on error resume next on the recordsetopening, to be able to see whether that's where the error arisees - in fact, for debugging, remove all errorhandling (or put a on error goto 0 at the top, if calling routines have errorhandling)

Try out some debugging - hit F9 on lines you wish to investigate, hit F8 while debugging to execute line by line, hover the mouse over variables etc to check state, select variables and hit Shift+F9 to do quick watch of variable values...

Roy-Vidar

 

[LevelThought]

Thank you for the insight. I will review the issues later today.

 

[LevelThought]

The Automation Error persists! Therefore, I have broken the code into two parts - The first part is to just export data to an Access table and then, upon successfully completing the first part, conditionally export new records or update pre-existing records within the Access database.

Displayed below is the code:

Sub ADOFromExcelToAccessTest()
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:\Access\CustomerReport.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "tblCustomer", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 2 ' 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
.Fields("ContractOrig").Value = Range("A" & r).Value
.Fields("ContractCurrent").Value = Range("B" & r).Value
.Fields("Account").Value = Range("C" & r).Value
.Fields("LastName").Value = Range("D" & r).Value
.Fields("FirstName").Value = Range("E" & r).Value
.Fields("DateTableUpdated").Value = Now()
.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


As I step through the code, an automation error continues to display when I get to the following line:

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\Access\CustomerReport.mdb;"


No records are added to the Access database!


Any insight as to the problem and a resolution would be greatly appreciated.

Thank you.

 

[JerryKlmns]

Change this

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\Access\CustomerReport.mdb;"

with

With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Data Source") ="C:\Access\CustomerReport.mdb;"
.Open
End With

Do you get any further?
Also, in Tools-->References is your
Microsoft ActiveX Data Objects 2.x Library checked? Is there and MISSING: ? If so uncheck the MISSING + Ok, then go and check it again...

Some more

change

rs.Open "tblCustomer", cn, adOpenKeyset, adLockOptimistic, adCmdTable

to

With rs
.ActiveConnection = Cn
.CursorLocation = adUseServer
.CursorType = adOpenForwardOnly
.LockType = adLockOptimistic
.Source = "Select * From tblCustomer;"
.Open
End With

for faster
and

.Fields("LastName").Value = Range("D" & r).Value
.Fields("FirstName").Value = Range("E" & r).Value
.Fields("DateTableUpdated").Value = Now()

to

.Fields("LastName") = "'" & Range("D" & r).Value & "'"
.Fields("FirstName") = "'" & Range("E" & r).Value & "'"
.Fields("DateTableUpdated") = "#" & Format (Date(),"yyyy-mm-dd") & "#"

I guess ContractOrig, ContractCurrent, Account is not text but numeric values and the field DateTableUpdated stores the date without the time part...

If you still get errors when opening the connection can you open the database itself?

Try that and post back

 

[LevelThought]

Jerry,

Tried the suggestions. The "Automation Error" appears to be quite stubborn...

The references I have are:

Visual Basic For Applications
Microsoft Excel 11.0 Object Library
OLE Automation
Microsoft Forms 2.0 Object Library
Microsoft ADO Ext. 2.7 for DDL and Security
Microsoft Access 11.0 Object Library

The format of the columns within Excel (and Access)is as follows:

ContractOrig - Text
ContractCurrent - Text
Account - Number

"DateTableUpdated" is the field within the local Access table that is formatted as "Date()" that should store the date without the time portion.


Displayed below is the code:

Sub ADOFromExcelToAccessAug13Test()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Data Source") = C:\Access\CustomerReport.mdb;"
.Open
End With
With rs
.ActiveConnection = cn
.CursorLocation = adUseServer
.CursorType = adOpenForwardOnly
.LockType = adLockOptimistic
.Source = "Select * from tblCustomer;"
.Open
End With
r = 2 ' 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("ContractOrig") = "" & Range("A" & r).Value & ""
.Fields("ContractCurrent") = "" & Range("B" & r).Value & ""
.Fields("Account") = "" & Range("C" & r).Value & ""
.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



Appreciate any additional information to resolve this problem.

 

[RoyVidar]

If you have only the references mentioned here, and not the one explicitly specified by JerryKlmns (ADO), then you should get a compile error (User-defined type not defined...) on the line declaring the connection.

ADOX (Microsoft ADO Ext. 2.7 for DDL and Security) and Access is not needed for this to run.

Now we know that it is the connection creating the trouble. First ensure you reference ADO, then work on the connection. Do take another a look at the link in my first reply, which has samples of connection strings for different setups with regards to security.

I have no problems with JerryKlmns' code on an unsecured database. Well, except, strip off the semicolon at the end of the string when assigning the properties individually (those are only necessary when assigning/opening by the complete connection string).

To test, create a new workbook, set a reference to ADO, open the connection and run a simple select, to check if there might be any problems with corruption of the existing workbook. If it still persist, try it on another computer, to see if there might be anything wrong with the setup (MDAC, Excel...)

You might also check out if you can get any more info from the connection, for instance use some errorhandling

[tt]dim adoerr as adodb.error
on error goto myerr
' the code

myexit:
exit sub

myerr:
for each adoerr in cn.errors
debug.print adoerr.number, adoerr.nativeerror, adoerr.description, adoerr.source
next adoerr
resume myexit
end sub [/tt]

BTW - did you check the connection state?

Roy-Vidar

 

[JerryKlmns]

After that With cn ... End With block add this (checks for connection state)

If Not cn.State=adStateOpen Then
MsgBox "Connection NOT Opened"
Exit Sub
End If

Set rs = New ADODB.Recordset

and on adding record
.Fields("ContractOrig") = "'" & Range("A" & r).Value & "'"
.Fields("ContractCurrent") = "'" & Range("B" & r).Value & "'"
.Fields("Account") = Range("C" & r).Value
.Fields("LastName") = "'" & Range("D" & r).Value & "'"
.Fields("FirstName") = "'" & Range("E" & r).Value & "'"
.Fields("DateTableUpdated") = "#" & Format (Date(),"yyyy-mm-dd") & "#"

Also add the error part of Roy and don't forget this (thanx Roy)
.Properties("Data Source") = "C:\Access\CustomerReport.mdb"

 

[LevelThought]

I will try the suggestions later today after taking a look at the samples of connection strings for different setups.

There is a password for the admin as well as a database password for the Access Database.

What would be the quickest way to eliminate the password for admin?

Based on the most recent postings, It appears that the problem is more likely due to the connection part of the code's handling of the passwords.

 

[JerryKlmns]

Your cn has 96 properties. Those declared here, are the necessary to open a connection to a database (C:\Access\CustomerReport.mdb) using user level security from a workgroup file (C:\Access\CustomerReport.mdw [change if it has different location/name]) and a database password (DBasePassword) for a user (TheUser) with a password (ThePassword). There is a check for open connection state.

Set cn = New ADODB.Connection
With cn
 .Provider = "Microsoft.Jet.OLEDB.4.0"
 .Properties("Data Source") = "C:\Access\CustomerReport.mdb"
 .Properties("Jet OLEDB:System database") = "C:\Access\CustomerReport.mdw"
 .Properties("User ID") = TheUser
 .Properties("Password") = ThePassword
 .Properties("Jet OLEDB:Database Password") = DBasePassword
 .Properties("Jet OLEDB:Engine Type") = 5
 .Properties("Mode") = adModeShareDenyNone
 .Properties("Jet OLEDB:Engine Type") = 5
 .Properties("Locale Identifier") = 1033
 .Open
 If Not cn.State = adStateOpen Then
   MsgBox "Connection NOT Opened"
   Set cn = Nothing
   Exit Sub
 Else
   MsgBox "Connection Opened Succesfully"
 End If
End With

 

[LevelThought]

I modified the code and finally was able to get the 1st part working successfully! The first part was to just export data from Excel to an Access table. However, I receive an error 3705 (Operation not allowed when the object is open) when I try to implement the second part of the code.

The second part of the code is to conditionally export new records or update pre-existing records within the Access database based on whether the account number on my Excel worksheet is already contained within the Access table(as mentioned in my posting on August 13th).

The code I am using is below. Any suggestions?

Sub CompleteDataToAccess()
Dim ADOC As New ADODB.Connection
Dim DBS As New ADODB.Recordset
ADOC.Open "Provider=Microsoft.Jet.oledb.4.0;" & _
"data source= C:\Access\Customer.mdb;"
DBS.Open "tblCustomer", ADOC, adOpenKeyset, _
adLockOptimistic
Sheets("Data").Activate
Range("A2").Select
On Error GoTo CompleteDataToAccess_err
Do Until ActiveCell.Value = ""
With DBS
strSQL = "select * from tblCustomer where AccNo = " & Range("C2") & ""
'On Error Resume Next
.Open strSQL, cn, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo 0
If .State = adStateOpen Then
If .EOF Then
DBS.AddNew
DBS!Contract = ActiveCell.Value
DBS!Name = ActiveCell.Offset(0, 1).Value
DBS!AccNo = ActiveCell.Offset(0, 2).Value
DBS!Balance = ActiveCell.Offset(0, 3).Value
DBS.Update
Else
DBS!AccNo = ActiveCell.Offset(0, 2).Value
DBS!Balance = ActiveCell.Offset(0, 3).Value
DBS.Update
End If
End If
End With
ActiveCell.Offset(1, 0).Select
Loop
CompleteDataToAccess_exit:
DBS.Close
ADOC.Close
Set ADOC = Nothing
Set DBS = Nothing
Exit Sub
CompleteDataToAccess_err:
MsgBox "Sorry - an error occurred..." & vbCrLf & "Number: " & Err.Number & _
vbCrLf & "Description: " & Err.Description
Resume CompleteDataToAccess_exit
End Sub

Thanks in advance.

 

[JerryKlmns]

LevelThought,

You should read more carefully all the posts because you are doing the same mistake as mentioned at the beginning...

 

[LevelThought]

Jerry,

Using your filter example was successful! The only additional questions are the following:

How would I modify the code so that I would obtain a count of the number of records that were updated and added to the database? For example, would it be possible to maintain a "running log" on another Excel Workbook located at C:\Access\UpdateLog.xls with the following columns that tracked the number of records that were updated and or created:

Date-----NoOfAccountsUpdated-----NoOfNewAccountsCreated
8/30/05--100---------------------10
8/31/05--85----------------------20

Each day, the Log would be populated upon the conclusion of the Sub.


Question 2, In your filter example, you state the following:

.Filter = "AccNo=" & ActiveCell.Range("Acct")

However, if the range that I want to compare to the Access Field is in column "C", I assume that I need to do something similar to the following where the range for the "C" column is "Acct":

.Filter = "AccNo=" & Range("Acct")


Question 3, I am trying to setup a dynamic range on an Excel template so that I do not have to re-configure the range name of "Enc" every day. Any thoughts on this?

Thanks for the insight.

 

[JerryKlmns]

LevelThought

Q1:
Use an integer to count updates and an other to count additions. Open your excel log file. Since the first line is for headers then the row you are to place the counters is the day+1 i.e. you run the code on 30 Sept 2005 then the row should be 30+1. Unless it is a log from day 1.In that case use the function DateDiff("d", Date, TheStartingDate) +1 to get the row.

Q2: ActiveCell.Range("Acct") is supposed to hold the value for filtering the recordset. You could use Cells("C", RowCounter.Value ................

Q3: There is a UsedRange property on a sheet.You have to dig this yourself. I haven't explore Excel that much...

 

[LevelThought]

I think that I might have spoken too soon!

Yes, the filter is working but it is only filtering against the value on the worksheet that is located at C2, just the first account number!

The range that I want to compare to the Access Field (titled "AcctNo")is in column "C." For example, I have an Excel worksheet with 150 rows that have a unique account number in column "C" beginning with row 2. It appears that I would need a row counter variable as you alluded to in the prior posting.

Any assistance as to where this would be setup in the code? Would the additional code go immediately after the "Loop" statement?

Initially, I thought of something similar to

".Filter = "AcctNo=" & ActiveCell.Offset(0, 2)."

However, this doesn't work.