Cannot connect to remote database through VBA

[Guest]

Can someone please look at my code and help me determine why it won't work?
I have been working on this for so long and made several changes to it, I'm
ready to tear my hair out. Originally, it was pulling only the first record
and then it was adding the first record so many times that I got an overflow
error. Now it is bombing out completely. Not knowing which database it is
referring to, I checked to see if anyone was in the remote database and they
were not.

Please help if you can!

Arlene

Error message:

Please record this information: Cannot start your application. The
workgroup information file is missing or opened exclusively by another user.
–2147217843 Microsoft JET Database Engine.

My Code:

Public Sub GetVocalIncidents()
On Error GoTo ErrHandler
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strSQL As String, strConnection As String
Dim TargetRS As Recordset
Set cnn = New ADODB.Connection
Dim fOpenedCnn As Boolean
Dim fOpenedRst As Boolean
Dim fOpenedTargetRS As Boolean

strSQL = "SELECT * FROM MyTable;"
strConnection = ""
cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;
Password=MyPassword;User ID=MyUserID; Data Source=MyDataSourcePath; Persist
Security Info=True; Jet OLEDB:System database=MySystemDB"
cnn.Open adOpenDynamic, adLockReadOnly
fOpenedCnn = True
Set rst = New ADODB.Recordset
With rst
.ActiveConnection = cnn
.Source = strSQL
.Open
fOpenedRst = True
End With
'Do something here
Set TargetRS = CurrentDb.OpenRecordset("TargetRecordset")
fOpenedTargetRS = True
With TargetRS
Do Until .EOF
Dim i As Integer
For i = 0 To .RecordCount - 1
.AddNew
TargetRS.Fields("Field 1") = rst.Fields("Field 1")

.Update
Next i
.MoveNext
Loop
.Close
End With
rst.Close
cnn.Close

Exit Sub

CleanUp:
If (fOpenedRst) Then
rst.Close
fOpenedRst = False
End If
If (fOpenedTargetRS) Then
TargetRS.Close
fOpenedTargetRS = False
End If
If (fOpenedCnn) Then
cnn.Close
fOpenedCnn = False
End If
Set rst = Nothing
Set TargetRS = Nothing
Set cnn = Nothing
Exit Sub

ErrHandler:
MsgBox "Please record this information: " & Err.Description & " " &
Err.Number & " " & Err.Source, vbOKOnly, "Error"
Err.Clear
GoTo CleanUp
End Sub

 

[SteveS]

I'm not sure what you are trying to do, but is looks like you are trying to
copy a field (from a record in an ADODB recordset - "rst") and create a new
record in a DAO recordset - "TargetRS".

'**** SNIP *******

'Do something here
Set TargetRS = CurrentDb.OpenRecordset("TargetRecordset")
fOpenedTargetRS = True
With TargetRS
Do Until .EOF
Dim i As Integer
For i = 0 To .RecordCount - 1
.AddNew
TargetRS.Fields("Field 1") = rst.Fields("Field 1")

.Update
Next i
.MoveNext
Loop
.Close
End With
rst.Close

'********* SNIP ***********

Looking at the code snippet above, you should never Dim a variable inside a
loop. It should be at the top of the subroutine with the other DIM statements.

It looks like you have your source and target recordsets mixed up.
You have a "FOR..NEXT" loop inside a "DO UNTIL" loop on your *target*
recordset. You will never reach the EOF because you are adding
"TargetRS.Recordcount" records (using the FOR..NEXT loop) each time you loop
using the "DO UNTIL...LOOP" statement and the recordcount keeps increasing each
DO UNTIL loop.

So if TargetRS initially has 10 records in it, the first time you step into the
DO UNTIL loop, you add 10 records (The FOR..NEXT loop). Now you go back to the
DO UNTIL..LOOP and TargetRS.Recordcount now equals 20 records. Now the
FOR...NEXT loop adds 20 records. TargetRS.Recordcount now is 40 and you have
only on the second record of the DO UNTIL loop. And the record count keeps
growing... you never reach EOF and you run out of room.



This is totally air code, but you might try making these changes to your code:


Move DIM i to top of Sub

Dim i As Integer


Change

Dim TargetRS As Recordset

to

Dim TargetRS As DAO.Recordset



'**** SNIP *******
'Do something here
Set TargetRS = CurrentDb.OpenRecordset("TargetRecordset")
fOpenedTargetRS = True
With rst
Do Until .EOF
TargetRS.AddNew
TargetRS.Fields("Field 1") = rst.Fields("Field 1")
TargetRS.Update
.MoveNext 'rst
Loop
End With
rst.Close

'********* SNIP ***********




So far, all I have used is DAO recordsets, so if I am way off base, I apologize.

HTH

 

[Guest]

Hi Steve,

Thanks for taking a look. The reason for the ADODB recordset is because I
couldn't figure out how to connect to the other (secured) database using DAO.
Someone gave me an example of how to connect using ADODB, but I usually do
use DAO.

I am still learning and appreciate your help. I'll try what you suggested
and see if I can get it to work.

Arlene

 

[SteveS]

Hi Steve,

Thanks for taking a look. The reason for the ADODB recordset is because I
couldn't figure out how to connect to the other (secured) database using DAO.
Someone gave me an example of how to connect using ADODB, but I usually do
use DAO.

I am still learning and appreciate your help. I'll try what you suggested
and see if I can get it to work.

Arlene

Hi, Arlene

So you are trying to copy from the ADODB recordset to the DAO recordset? It
helps to know the goal when looking at code.


Also, (sorry - it was late at night) this line:

should be

TargetRS.Fields("Field 1") = .Fields("Field 1")

(remove the "rst")

 

[Guest]

Hi Steve,

I would prefer to use DAO for both, but I tried for days and couldn't figure
it out so I used the ADODB example someone gave me. I looked and could not
find an example for DAO. In reference to your last post, are you saying that
I don't need rst.fields, just .fields and it will work?

Arlene

 

[SteveS]

Hi Steve,

I would prefer to use DAO for both, but I tried for days and couldn't figure
it out so I used the ADODB example someone gave me. I looked and could not
find an example for DAO. In reference to your last post, are you saying that
I don't need rst.fields, just .fields and it will work?

Arlene

There is nothing wrong with using ADO... I haven't had occasion to use it yet.
I did find a way to open a password protected db (I think) using DAO and Query
defs. In A2K help, click on the INDEX tab and search for "CreateQueryDef".
Select "CreateQueryDef Method" in the topic (lower) list. In the right hand
pane, click on "Example" and then on the second (bottom) example.


When you use "WITH...END WITH", the reference to the object you are using (in
this case rst) is resolved once. So within the "WITH rst ... END WITH"
statement you don't have to use "rst".

This
'***snip***
With rst
Do Until .EOF
TargetRS.AddNew
TargetRS.Fields("Field 1") = .Fields("Field 1")
TargetRS.Update
.MoveNext 'rst
Loop
End With
'***snip***

is equivalent to

'***snip***

Do Until rst.EOF
TargetRS.AddNew
TargetRS.Fields("Field 1") = rst.Fields("Field 1")
TargetRS.Update
rst.MoveNext
Loop

'***snip***


From what I have read, using "WITH...END WITH" is faster, but you probably
won't see any difference in speed between the two pieces of code above unless
they involve huge recordsets.

 

[Guest]

Hi Steve,

Thanks again for your help. I have been trying to look up CreateQueryDef in
Access 2000 Help at work, but unable to do so. I get alot of errors when I
go into Help and have tried to get our IT to fix it but they keep telling me
that there is NO problem with it. I'll on my machine at home tonight.

Thanks again!

Arlene