jtfrier
Technical User
- Jan 12, 2006
- 85
I have a Module in MS Access with this code and I need to know how to call it runing a query
Code:
Option Compare Database
Option Explicit
Public Sub RSLoop()
Dim rs As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim varPart As String
Dim cntr As Long
Dim varDesc
On Error GoTo ErrorHere
DoCmd.SetWarnings False
Set rs = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
rs.Open "SELECT Edmanmanruby.partno, Edmanmanruby.desc " & _
"FROM Edmanmanruby " & _
"ORDER BY Edmanmanruby.partno", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
rs.MoveFirst
Do While Not rs.EOF
2 varPart = rs!partno
cntr = 1
1 If rs!partno = varPart Then
If cntr = 1 Then
DoCmd.RunSQL "UPDATE tblDesc " & _
"SET descrip = '" & rs!desc & "' " & _
"WHERE (((tblDesc.partno) = '" & varPart & "'))"
Else
rs2.Open "SELECT tblDesc.descrip " & _
"FROM tblDesc " & _
"WHERE (((tblDesc.partno) = '" & varPart & "'))", CurrentProject.Connection
varDesc = rs2!descrip
rs2.Close
DoCmd.RunSQL "UPDATE tblDesc " & _
"SET descrip = '" & varDesc & "' & '" & rs!desc & "' WHERE (((tblDesc.partno) = '" & varPart & "'))"
End If
rs.MoveNext
cntr = cntr + 1
GoTo 1
Else
'rs.MoveNext
GoTo 2
End If
Loop
MsgBox "All Done"
ExitHere:
3 rs.Close
'rs2.Close
Set rs = Nothing
Set rs2 = Nothing
DoCmd.SetWarnings True
Exit Sub
ErrorHere:
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere
End Sub