Solved: error No Current Record after myrs.addnew

[Movian]

hey,
after solving my problem yesterday i have stumbled upon a problem with a new feature i have been asked to develop.
This system is suposed to take a table of information and out put all that information to a spreadsheet.
That portion works fine, however the system also needs to be able to import a spreadsheet laid out in the same fashion.
i have created the following sub procedure in a module that is called from the form. However i keep getting a "No Current Record" on the myrs.edit line which imediatly follows the myrs.addnew!!!! so if i just added a new record how can it say there isn't one... :banghead:

any way any help would be very much apriciated :D

Public Sub ImportPhysicians()
Dim oApp As Object
Dim oDoc As Object
Dim count As Integer
Dim data(0 To 10) As String
Dim flag As Boolean
flag = True
count = 0
Set oApp = CreateObject("Excel.Application")

If oApp Is Nothing Then
MsgBox "The application is not available!", vbExclamation
End If
oApp.Workbooks.Open CurrentProject.path + "\Physicians.xls"
' open Table and export Physician Information
Dim mydb As DAO.Database, myrs As DAO.Recordset
Set mydb = CurrentDb()
Set myrs = mydb.OpenRecordset("tblPhys")
On Error Resume Next
myrs.MoveLast
myrs.MoveFirst
On Error GoTo 0
While Not myrs.EOF
DoCmd.RunCommand acCmdDeleteRecord
myrs.MoveNext
Wend
count = 0
While flag = True
count = count + 1
data(0) = oApp.activeworkbook.worksheets("Sheet1").Range("A" + Mid(str(count + 1), 2, 1)).value
data(1) = oApp.activeworkbook.worksheets("Sheet1").Range("B" + Mid(str(count + 1), 2, 1)).value
data(2) = oApp.activeworkbook.worksheets("Sheet1").Range("C" + Mid(str(count + 1), 2, 1)).value
data(3) = oApp.activeworkbook.worksheets("Sheet1").Range("D" + Mid(str(count + 1), 2, 1)).value
data(4) = oApp.activeworkbook.worksheets("Sheet1").Range("E" + Mid(str(count + 1), 2, 1)).value
data(5) = oApp.activeworkbook.worksheets("Sheet1").Range("F" + Mid(str(count + 1), 2, 1)).value
data(6) = oApp.activeworkbook.worksheets("Sheet1").Range("G" + Mid(str(count + 1), 2, 1)).value
data(7) = oApp.activeworkbook.worksheets("Sheet1").Range("H" + Mid(str(count + 1), 2, 1)).value
data(8) = oApp.activeworkbook.worksheets("Sheet1").Range("I" + Mid(str(count + 1), 2, 1)).value
data(9) = oApp.activeworkbook.worksheets("Sheet1").Range("J" + Mid(str(count + 1), 2, 1)).value
data(10) = oApp.activeworkbook.worksheets("Sheet1").Range("K" + Mid(str(count + 1), 2, 1)).value
If data(0) = Null Or data(0) = "" Then
flag = False
End If
If flag = True Then
myrs.AddNew
myrs.MoveFirst
myrs.Edit
myrs.Fields("PhysID") = count
myrs.Fields("Referring Phys") = data(0)
myrs.Fields("FirstName") = data(1)
myrs.Fields("LastName") = data(2)
myrs.Fields("Addr") = data(3)
myrs.Fields("City") = data(4)
myrs.Fields("St") = data(5)
myrs.Fields("Zip") = data(6)
myrs.Fields("phone") = data(7)
myrs.Fields("fax") = data(8)
myrs.Fields("e-mail") = data(9)
myrs.Fields("comment") = data(10)
myrs.Update
End If
Wend

oApp.activeworkbook.Close
oApp.Close
Set oDoc = Nothing ' free memory
Set oApp = Nothing ' free memory
myrs.Close

[CreganTur]

I hate it when i get that error message for DAO connections.

A couple of things:
1) I would caution you against using the While...Wend loop structure. It's only in VBA for backwards compatability. It's also a limited looping structure when you compare it to the other structures available (see my Article if you're interested in knowing more).

2) your code could be improved a little and gain a little speed boost if you use With, like this:

If flag = True Then
With myrs
.AddNew
.MoveLast
.Edit
.Fields("PhysID") = count
.Fields("Referring Phys") = data(0)
.Fields("FirstName") = data(1)
.Fields("LastName") = data(2)
.Fields("Addr") = data(3)
.Fields("City") = data(4)
.Fields("St") = data(5)
.Fields("Zip") = data(6)
.Fields("phone") = data(7)
.Fields("fax") = data(8)
.Fields("e-mail") = data(9)
.Fields("comment") = data(10)
.Update
End If


I changed your .MoveFirst to a .MoveLast because new records are added to the end of a recordset and I'm wondering if that might be what's causing your error.


Something to think about:
Since your data is held in an array, then we can compact your code a little more by using a For...Next loop to iterate through the fields by referring to the field's ordinal number instead of its name. Now, this may not work for you if the data in your array is arranged in such a way that it is not compatible with the field ordinal numbers. Example: Field(1) could be "LastName" , but your data(1) is your first name. There can be ways to compensate for this. I'm going to assume that your Fields("PhysID") is Fields(0), and that all your fields are in the correct ordinal arrangement to match your array. It would look something like:

Dim i As Integer
If flag = True Then
With myrs
.AddNew
.MoveLast
.Edit
.Fields("PhysID") = count
For i = 0 To 10
.Fields(i + 1) = data(i)
Next
.Update
End If

[Movian]

ok so my new "Compact" sub looks like this

Public Sub ImportPhysicians()
Dim oApp As Object
Dim oDoc As Object
Dim count As Integer
Dim data(0 To 10) As String
Dim flag As Boolean
flag = True
count = 0
Set oApp = CreateObject("Excel.Application")

If oApp Is Nothing Then
MsgBox "The application is not available!", vbExclamation
End If
oApp.Workbooks.Open CurrentProject.path + "\Physicians.xls"
' open Table and export Physician Information
Dim mydb As DAO.Database, myrs As DAO.Recordset
Set mydb = CurrentDb()
Set myrs = mydb.OpenRecordset("tblPhys")

myrs.movefirst
Do Until myrs.EOF
DoCmd.RunCommand acCmdDeleteRecord
myrs.MoveNext
Loop

count = 0
Do Until flag = False
count = count + 1
data(0) = oApp.activeworkbook.worksheets("Sheet1").Range("A" + Mid(str(count + 1), 2, 1)).value
data(1) = oApp.activeworkbook.worksheets("Sheet1").Range("B" + Mid(str(count + 1), 2, 1)).value
data(2) = oApp.activeworkbook.worksheets("Sheet1").Range("C" + Mid(str(count + 1), 2, 1)).value
data(3) = oApp.activeworkbook.worksheets("Sheet1").Range("D" + Mid(str(count + 1), 2, 1)).value
data(4) = oApp.activeworkbook.worksheets("Sheet1").Range("E" + Mid(str(count + 1), 2, 1)).value
data(5) = oApp.activeworkbook.worksheets("Sheet1").Range("F" + Mid(str(count + 1), 2, 1)).value
data(6) = oApp.activeworkbook.worksheets("Sheet1").Range("G" + Mid(str(count + 1), 2, 1)).value
data(7) = oApp.activeworkbook.worksheets("Sheet1").Range("H" + Mid(str(count + 1), 2, 1)).value
data(8) = oApp.activeworkbook.worksheets("Sheet1").Range("I" + Mid(str(count + 1), 2, 1)).value
data(9) = oApp.activeworkbook.worksheets("Sheet1").Range("J" + Mid(str(count + 1), 2, 1)).value
data(10) = oApp.activeworkbook.worksheets("Sheet1").Range("K" + Mid(str(count + 1), 2, 1)).value
If data(0) = Null Or data(0) = "" Then
flag = False
End If
Dim i As Integer
If flag = True Then
With myrs
.AddNew
.MoveLast
.Edit
.Fields("PhysID") = count
For i = 0 To 10
.Fields(i + 1) = data(i)
Next
.Update
End With
End If
Loop

oApp.activeworkbook.Close
oApp.Close
Set oDoc = Nothing ' free memory
Set oApp = Nothing ' free memory
myrs.Close
End Sub
Unfortunatly i still have the same problem although this time it refrence the movelast as the cause of the error.
Which is still No Current Record .... :bug:

[CreganTur]

I'm sorry- I was wrong about the .MoveLast.

Try this:


If flag = True Then
With myrs
.AddNew
!PhysID = count
!Referring Phys = data(0)
!FirstName = data(1)
!LastName = data(2)
!Addr = data(3)
!City = data(4)
!St = data(5)
!Zip = data(6)
!phone = data(7)
!fax = data(8)
!e-mail = data(9)
!comment = data(10)
.Update
End With
End If


or This:

If flag = True Then
With myrs
.AddNew
.Fields("PhysID") = count
For i = 0 To 10
.Fields(i + 1) = data(i)
Next
.Update
End With
End If


Hope this works *fingers crossed*

[Movian]

YAY!!!

3 iteration of code worked
now i just have to get over the last problem of a data type conversion error! :(

it seems to be erroring when trying to put a string into a memo field ....
never had that problem before!

hmm question do the field numbers start from 0 or 1 ?

[CreganTur]

it seems to be erroring when trying to put a string into a memo field ....

Have you tried throwing in a debug.print so you can see exactly what data is being pushed to your Memo field? This might reveal what the problem is.

[Movian]

"Thank you for giving me the opportunity to share in the care of this patient."

thats whats in data(10) trying to be put in fields(11)
:\ which as far as i can tell it a standard Memo field.

*EDIT! AHAHA!
figured out why i couldn't compile itteration 2 of your suggested fixes,
and this now works! :D
here is the final solution.

Public Sub ImportPhysicians()
Dim oApp As Object
Dim oDoc As Object
Dim count As Integer
Dim data(0 To 10) As String
Dim flag As Boolean
flag = True
count = 0
Set oApp = CreateObject("Excel.Application")

If oApp Is Nothing Then
MsgBox "The application is not available!", vbExclamation
End If
oApp.Workbooks.Open CurrentProject.path + "\Physicians.xls"
' open Table and export Physician Information
Dim mydb As DAO.Database, myrs As DAO.Recordset
Set mydb = CurrentDb()
Set myrs = mydb.OpenRecordset("tblPhys")
On Error Resume Next
myrs.MoveFirst
On Error GoTo 0
Do Until myrs.EOF
DoCmd.RunCommand acCmdDeleteRecord
myrs.MoveNext
Loop

count = 0
Do Until flag = False
count = count + 1
data(0) = oApp.activeworkbook.worksheets("Sheet1").Range("A" + Mid(str(count + 1), 2, 1)).value
data(1) = oApp.activeworkbook.worksheets("Sheet1").Range("B" + Mid(str(count + 1), 2, 1)).value
data(2) = oApp.activeworkbook.worksheets("Sheet1").Range("C" + Mid(str(count + 1), 2, 1)).value
data(3) = oApp.activeworkbook.worksheets("Sheet1").Range("D" + Mid(str(count + 1), 2, 1)).value
data(4) = oApp.activeworkbook.worksheets("Sheet1").Range("E" + Mid(str(count + 1), 2, 1)).value
data(5) = oApp.activeworkbook.worksheets("Sheet1").Range("F" + Mid(str(count + 1), 2, 1)).value
data(6) = oApp.activeworkbook.worksheets("Sheet1").Range("G" + Mid(str(count + 1), 2, 1)).value
data(7) = oApp.activeworkbook.worksheets("Sheet1").Range("H" + Mid(str(count + 1), 2, 1)).value
data(8) = oApp.activeworkbook.worksheets("Sheet1").Range("I" + Mid(str(count + 1), 2, 1)).value
data(9) = oApp.activeworkbook.worksheets("Sheet1").Range("J" + Mid(str(count + 1), 2, 1)).value
data(10) = oApp.activeworkbook.worksheets("Sheet1").Range("K" + Mid(str(count + 1), 2, 1)).value
If data(0) = Null Or data(0) = "" Then
flag = False
End If
Dim i As Integer
If flag = True Then
With myrs
.AddNew
!PhysID = count
![Referring Phys] = data(0)
!FirstName = data(1)
!LastName = data(2)
!Addr = data(3)
!City = data(4)
!St = data(5)
!Zip = data(6)
!phone = data(7)
!fax = data(8)
![e-mail] = data(9)
!comment = data(10)
.Update
End With
End If
Loop

oApp.activeworkbook.Close
Set oDoc = Nothing ' free memory
Set oApp = Nothing ' free memory
myrs.Close
End Sub

[CreganTur]

*EDIT! AHAHA!
figured out why i couldn't compile itteration 2 of your suggested fixes,
and this now works! :D
here is the final solution.


Heh... yeah I was thinking that might be the problem.

Glad I could help :thumb

Don't forget to tag this as solved, if your issue's resolved (Thread Tools -> Mark as Solved)