asked on

recordset close not in right place

exce vba 2010...

I have the following working ok...but it seems to me the recordset , opening and closing is just not quite right.

This code was converted from vba 2003 dao

' Green Data
Dim db As New ADODB.Connection
Dim rec As New ADODB.Recordset

Dim xsearch As String
Dim rng As Range, cell As Range
Dim str As String
Dim str2 As String
Dim falpha As String

str = wrange
str2 = str

If IsNumeric(Mid(str2, 2, 1)) Then
falpha = Left(str2, 1)
Else
falpha = Left(str2, 2)
End If

str = falpha

Set rng = Range(str & "2" & ":" & str & Cells(65536, str).End(xlUp).Row)
For Each cell In rng

xsearch = "SELECT tblGreenMasterSkus.fldGreenAlt FROM tblGreenMasterSkus Where tblGreenMasterSkus.fldGreenSku =""" & cell.Value & """;"

db.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Program Files\Crs Enterprise\EnterpriseDatabases\TextFile_Setup.accdb"

rec.Open sQuery, db, adOpenKeyset, adLockOptimistic

While Not rec.EOF
If cell.Offset(0, 8).Value <> "" Then
cell.Offset(0, 8).Value = cell.Offset(0, 8).Value & " : " & rec.Fields("fldGreenAlt")
Else
'
cell.Offset(0, 8).Value = rec.Fields("fldGreenAlt")
cell.Offset(0, 7).Value = "Y"

End If
rec.MoveNext

Wend

rec.Close
db.Close

Next cell
On Error Resume Next

rec.Close
db.Close
Set rec = Nothing
Set db = Nothing
End Sub

Member_2_861731

You don't need to open/close the connection each time you open the recordset, so you can leave the connection open through your entire loop.
The recordset though, needs to be opened and closed each time you want to refresh the data.

Something like:

' Green Data
Dim db As New ADODB.Connection
Dim rec As New ADODB.Recordset


Dim xsearch As String
Dim rng As Range, cell As Range
Dim str As String
Dim str2 As String
Dim falpha As String
    
    str = wrange
       str2 = str

If IsNumeric(Mid(str2, 2, 1)) Then
   falpha = Left(str2, 1)
Else
     falpha = Left(str2, 2)
End If

str = falpha

 db.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
               "Data Source=C:\Program Files\Crs Enterprise\EnterpriseDatabases\TextFile_Setup.accdb"

Set rng = Range(str & "2" & ":" & str & Cells(65536, str).End(xlUp).Row)
For Each cell In rng
   
       xsearch = "SELECT tblGreenMasterSkus.fldGreenAlt FROM tblGreenMasterSkus Where tblGreenMasterSkus.fldGreenSku =""" & cell.Value & """;"

rec.Open sQuery, db, adOpenKeyset, adLockOptimistic
 
 
While Not rec.EOF
  If cell.Offset(0, 8).Value <> "" Then
  cell.Offset(0, 8).Value = cell.Offset(0, 8).Value & " : " & rec.Fields("fldGreenAlt")
  Else
   '
  cell.Offset(0, 8).Value = rec.Fields("fldGreenAlt")
   cell.Offset(0, 7).Value = "Y"
  
  
  End If
  rec.MoveNext
  
  
  Wend

rec.Close


  Next cell
 On Error Resume Next <-- You can remove this because you're testing for open state before closing.
 
if rec.State=adodb.Open then
    rec.Close
end if
if db.State=adodb.Open then
    db.Close
end if
Set rec = Nothing
Set db = Nothing
End Sub

Open in new window

I also added an if statement so that you close the connection and recordset only when they are open, avoiding unwanted errors.

Let us know if it works for you.

*EDIT* Removed double "only"...

Fordraiders

ASKER

ERROR here ADOB error?

if rec.State=adodb.Open then <------ method or data member notfound

ASKER CERTIFIED SOLUTION

Member_2_861731

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Fordraiders

ASKER

Thanks