I am trying to read and then update an Access Database using Excel VBA
code. When I run the code below on a PC that has XP/Excel & Access
2003 - it works fine. When I run the same code on my home computer -
which has VISTA/Excel & Access 2007 - it fails with a "Microsoft
Database Engine Stopped because you and another user are attempting to
change the same data at the same time" error.

BUT - when I step through the code - it works fine, so the problem has
something to do with the Code executing too fast for the ODBC
connection??? Not sure if it is VISTA, or if it has something to do
with the 2007 version of EXCEL or ACCESS.

Has anyone else run into this?? And/or does anyone have a solution as
to how I could slow it all down, so it works.

HELP.......


Dim rs As Recordset
Set rs = CreateObject("ADODB.Recordset")
Dim rs2 As Recordset
Set rs2 = CreateObject("ADODB.Recordset")
Dim rsTeam As Recordset
Set rsTeam = CreateObject("ADODB.Recordset")
Dim rsIce As Recordset
Set rsIce = CreateObject("ADODB.Recordset")
Dim sLevel As String
Dim sSql As String
Dim sSql2 As String
Dim sSqlUpdt1 As String
Dim sSqlUpdt2 As String
Dim sNov As Integer
Dim sDec As Integer
Dim sJan As Integer
Dim sFeb As Integer
Dim sMar As Integer
Dim sIceMax As Integer
Dim sMoAvg As Integer
Dim sLastDt As Date
Dim sLvlCnt As Integer
Dim sAlldone As Boolean
Dim sTeam As String
Dim sIceCnt As Integer
Dim sEventStart As Date
Dim sHrsDone As Boolean
Dim sOrder As Integer


sAlldone = False
sTime = "#12/30/1899 8:0:0#"
sHrsDone = False


Do Until sAlldone
sSql2 = "SELECT SchedDate, EventStart, Home, home_level,
Event_Type " & _
"FROM Initiation_ice " & _
"WHERE home = '' " & _
"AND EventStart < " & sTime & _
" order by schedDate" & ";"
With rsIce
.Source = sSql2
.ActiveConnection = "ice_scheduling"
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Open
If rsIce.RecordCount = 0 Then
sAlldone = True
rsIce.Close
Else
res = rsIce.GetRows
lrows = UBound(res, 2)

r = 0
sIceDate = res(0, r)
sMonth = Month(sIceDate)
sMonthName = MonthName(sMonth)

sSql = "SELECT Team, Hours_rcvd, max_hrs, hours_complete,
assign_order, team_information.level, " & _
"nov_hrs, dec_hrs, jan_hrs, feb_hrs, mar_hrs " & _
"FROM team_information " & _
"WHERE hours_complete = " & sHrsDone & _
" order by hours_rcvd, assign_order" & ";"
With rsTeam
.Source = sSql
.ActiveConnection = "ice_scheduling"
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Open
If rsTeam.RecordCount = 0 Then
sAlldone = True
rsTeam.Close
Else
res = rsTeam.GetRows
lrows = UBound(res, 2)

r = 0
sTeam = res(0, r)
sIceCnt = res(1, r)
sIceMax = res(2, r)
sOrder = res(4, r)
sLevel = res(5, r)
sIceCnt = sIceCnt + 1
sNov = res(6, r)
sDec = res(7, r)
sJan = res(8, r)
sFeb = res(9, r)
sMar = res(10, r)
If sMonthName = "November" Then
sNov = sNov + 1
Else
If sMonthName = "December" Then
sDec = sDec + 1
Else
If sMonthName = "January" Then
sJan = sJan + 1
Else
If sMonthName = "February" Then
sFeb = sFeb + 1
Else
sMar = sMar + 1
End If
End If
End If
End If

With rsTeam
If .EOF Then
.MoveFirst

If sIceCnt = sIceMax Then
.Fields(3).Value = True
.Fields(1).Value = sIceCnt
.Fields(6).Value = sNov
.Fields(7).Value = sDec
.Fields(8).Value = sJan
.Fields(9).Value = sFeb
.Fields(10).Value = sMar
.Update
Else
.Fields(1).Value = sIceCnt
.Fields(6).Value = sNov
.Fields(7).Value = sDec
.Fields(8).Value = sJan
.Fields(9).Value = sFeb
.Fields(10).Value = sMar
.Update
End If
End If

End With

rsTeam.Close

End If
End With
If sAlldone = False Then
With rsIce
If .EOF Then
.MoveFirst
.Fields(2).Value = sTeam
.Fields(3).Value = sLevel
.Fields(4).Value = "Practice"
.Update
End If
End With
End If

rsIce.Close

End If
End With
Loop

End Sub

Hi
Throwing in the line

DoEvents

is often helpful. Put it at the bottom of your loop.
regards
Paul

On Aug 31, 1:37*pm, wrote:
I am trying to read and then update an Access Database using Excel VBA
code. *When I run the code below on a PC that has XP/Excel & Access
2003 - it works fine. *When I run the same code on my home computer -
which has VISTA/Excel & Access 2007 - it fails with a "Microsoft
Database Engine Stopped because you and another user are attempting to
change the same data at the same time" error.

BUT - when I step through the code - it works fine, so the problem has
something to do with the Code executing too fast for the ODBC
connection??? *Not sure if it is VISTA, or if it has something to do
with the 2007 version of EXCEL or ACCESS.

Has anyone else run into this?? *And/or does anyone have a solution as
to how I could slow it all down, so it works.

HELP.......

Dim rs As Recordset
Set rs = CreateObject("ADODB.Recordset")
Dim rs2 As Recordset
Set rs2 = CreateObject("ADODB.Recordset")
Dim rsTeam As Recordset
Set rsTeam = CreateObject("ADODB.Recordset")
Dim rsIce As Recordset
Set rsIce = CreateObject("ADODB.Recordset")
Dim sLevel As String
Dim sSql As String
Dim sSql2 As String
Dim sSqlUpdt1 As String
Dim sSqlUpdt2 As String
Dim sNov As Integer
Dim sDec As Integer
Dim sJan As Integer
Dim sFeb As Integer
Dim sMar As Integer
Dim sIceMax As Integer
Dim sMoAvg *As Integer
Dim sLastDt As Date
Dim sLvlCnt As Integer
Dim sAlldone As Boolean
Dim sTeam As String
Dim sIceCnt As Integer
Dim sEventStart As Date
Dim sHrsDone As Boolean
Dim sOrder As Integer

sAlldone = False
sTime = "#12/30/1899 8:0:0#"
sHrsDone = False

Do Until sAlldone
* * sSql2 = "SELECT SchedDate, EventStart, Home, home_level,
Event_Type " & _
* * * * "FROM Initiation_ice " & _
* * * * "WHERE home = '' " & _
* * * * "AND EventStart < " & sTime & _
* * * * " order by schedDate" & ";"
* * With rsIce
* * * * .Source = sSql2
* * * * .ActiveConnection = "ice_scheduling"
* * * * .CursorType = adOpenStatic
* * * * .LockType = adLockOptimistic
* * * * .Open
* * * * If rsIce.RecordCount = 0 Then
* * * * * * sAlldone = True
* * * * * * rsIce.Close
* * * * Else
* * * * * * res = rsIce.GetRows
* * * * * * lrows = UBound(res, 2)

* * * * * * r = 0
* * * * * * sIceDate = res(0, r)
* * * * * * sMonth = Month(sIceDate)
* * * * * * sMonthName = MonthName(sMonth)

* * * * * * sSql = "SELECT Team, Hours_rcvd, max_hrs, hours_complete,
assign_order, team_information.level, " & _
* * * * * * * * * * "nov_hrs, dec_hrs, jan_hrs, feb_hrs, mar_hrs " & _
* * * * * * * * * * "FROM team_information " & _
* * * * * * * * * * "WHERE hours_complete = " & sHrsDone & _
* * * * * * * * * * " order by hours_rcvd, assign_order" & ";"
* * * * * * With rsTeam
* * * * * * * * .Source = sSql
* * * * * * * * .ActiveConnection = "ice_scheduling"
* * * * * * * * .CursorType = adOpenStatic
* * * * * * * * .LockType = adLockOptimistic
* * * * * * * * .Open
* * * * * * * * If rsTeam.RecordCount = 0 Then
* * * * * * * * * * sAlldone = True
* * * * * * * * * * rsTeam.Close
* * * * * * * * Else
* * * * * * * * * * res = rsTeam.GetRows
* * * * * * * * * * lrows = UBound(res, 2)

* * * * * * * * * * r = 0
* * * * * * * * * * * * sTeam = res(0, r)
* * * * * * * * * * * * sIceCnt = res(1, r)
* * * * * * * * * * * * sIceMax = res(2, r)
* * * * * * * * * * * * sOrder = res(4, r)
* * * * * * * * * * * * sLevel = res(5, r)
* * * * * * * * * * * * sIceCnt = sIceCnt + 1
* * * * * * * * * * * * sNov = res(6, r)
* * * * * * * * * * * * sDec = res(7, r)
* * * * * * * * * * * * sJan = res(8, r)
* * * * * * * * * * * * sFeb = res(9, r)
* * * * * * * * * * * * sMar = res(10, r)
* * * * * * * * * * * * If sMonthName = "November" Then
* * * * * * * * * * * * * * sNov = sNov + 1
* * * * * * * * * * * * Else
* * * * * * * * * * * * * * If sMonthName = "December" Then
* * * * * * * * * * * * * * * * sDec = sDec + 1
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * If sMonthName = "January" Then
* * * * * * * * * * * * * * * * * * sJan = sJan + 1
* * * * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * * * If sMonthName = "February" Then
* * * * * * * * * * * * * * * * * * * * sFeb = sFeb + 1
* * * * * * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * * * * * sMar = sMar + 1
* * * * * * * * * * * * * * * * * * End If
* * * * * * * * * * * * * * * * End If
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * End If

* * * * * * * * * * With rsTeam
* * * * * * * * * * * * If .EOF Then
* * * * * * * * * * * * * * .MoveFirst

* * * * * * * * * * * * * * If sIceCnt = sIceMax Then
* * * * * * * * * * * * * * * * .Fields(3).Value = True
* * * * * * * * * * * * * * * * .Fields(1).Value = sIceCnt
* * * * * * * * * * * * * * * * .Fields(6).Value = sNov
* * * * * * * * * * * * * * * * .Fields(7).Value = sDec
* * * * * * * * * * * * * * * * .Fields(8).Value = sJan
* * * * * * * * * * * * * * * * .Fields(9).Value = sFeb
* * * * * * * * * * * * * * * * .Fields(10).Value = sMar
* * * * * * * * * * * * * * * * .Update
* * * * * * * * * * * * * * Else
* * * * * * * * * * * * * * * * .Fields(1).Value = sIceCnt
* * * * * * * * * * * * * * * * .Fields(6).Value = sNov
* * * * * * * * * * * * * * * * .Fields(7).Value = sDec
* * * * * * * * * * * * * * * * .Fields(8).Value = sJan
* * * * * * * * * * * * * * * * .Fields(9).Value = sFeb
* * * * * * * * * * * * * * * * .Fields(10).Value = sMar
* * * * * * * * * * * * * * * * .Update
* * * * * * * * * * * * * * End If
* * * * * * * * * * * * End If

* * * * * * * * * * End With

* * * * * * * * * * rsTeam.Close

* * * * * * * * End If
* * * * * * End With
* * * * * * If sAlldone = False Then
* * * * * * * * With rsIce
* * * * * * * * * * If .EOF Then
* * * * * * * * * * * * .MoveFirst
* * * * * * * * * * * * .Fields(2).Value = sTeam
* * * * * * * * * * * * .Fields(3).Value = sLevel
* * * * * * * * * * * * .Fields(4).Value = "Practice"
* * * * * * * * * * * * .Update
* * * * * * * * * * End If
* * * * * * * * End With
* * * * * * End If

* * * * * * rsIce.Close

* * * * End If
* * End With
Loop

End Sub

I tried that and it didn't help. It seems to be a VISTA issue.

I loaded 2007 on another desktop I have that still has XP, and ran it
and it worked fine, so must be the VISTA.

I put the DoEvents Statement right before the Loop - seemed like that
should do it, but it still bombs. When I step through the code
(meaning there is time for the database updates to actually take) - it
works fine - so I somehow need to slow the application down - gotta
love VISTA

Hi
You didn't try it inside the loop?
Talking of vista, I have some code which uses DoEvents to animate a
graph smoothly. In Vista I have to put 3 consecutive DoEvents lines in
to make it go at all - like "Do the bl**y event will you!"
Paul

On Sep 1, 6:34*pm, wrote:
I tried that and it didn't help. *It seems to be a VISTA issue.

I loaded 2007 on another desktop I have that still has XP, and ran it
and it worked fine, so must be the VISTA.

I put the DoEvents Statement right before the Loop - seemed like that
should do it, but it still bombs. *When I step through the code
(meaning there is time for the database updates to actually take) - it
works fine - so I somehow need to slow the application down - gotta
love VISTA

On Sep 2, 2:49*am, wrote:
Hi
You didn't try it inside the loop?
Talking of vista, I have some code which uses DoEvents to animate a
graph smoothly. In Vista I have to put 3 consecutive DoEvents lines in
to make it go at all - like "Do the bl**y event will you!"
Paul

On Sep 1, 6:34*pm, wrote:



I tried that and it didn't help. *It seems to be a VISTA issue.

I loaded 2007 on another desktop I have that still has XP, and ran it
and it worked fine, so must be the VISTA.

I put the DoEvents Statement right before the Loop - seemed like that
should do it, but it still bombs. *When I step through the code
(meaning there is time for the database updates to actually take) - it
works fine - so I somehow need to slow the application down - gotta
love VISTA- Hide quoted text -

- Show quoted text -

It was within the Loop. I may play a bit with what you did - adding a
few DoEvents statements - you did make me laugh though.... THANKS.