By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
425,696 Members | 2,213 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 425,696 IT Pros & Developers. It's quick & easy.

HELP!! VB6 mdb DAO Problem

P: n/a
tym
HELP!!!

I'm going round the twist with this...

I have a VB6 application which is using DAO to access a database
(Please - no lectures on ADO, I know what I'm doing with DAO!!)

Ok, problem is this....

importing a large csv file (189000 lines, 7 fileds per line)

Import this into various tables fine - takes a a couple of minutes...
the problem is when I then process these tables.

The progam is basically split into 2
-----------------------------------------------------------------------------------------------
Process A:
table name held in RECORDSETtables

For each table ( 0 - 6)

for each day (1 - 365)
call RoutineB(table,day)

next day

Next Table

RECORDSETtables.close

END

-----------------------------------------------------------------------------------------------

Routine B (sTABLE as string, sDATE as string)

set RecordsetTABLE = db.openrecordset(open table Day&date,
vbopendynaset)
if not error
table exists
exit routine
' don't need to process as data already exists
elseif
'create table to store data in later
end if

set RECORDSETdata = db.openrecordset(select data from sTABLE with
Specified sDate)

for each record in RECORDSETdata

long and itterative calcualtions.
store data in ARRAY(48,30)

next RECORDSETdata
close RECORDSETdata
with RecordsetTABLE
for each line in ARRAY(48,30)
.add new
.fields(1-48) = ARRAY(line,1-48)
.update
next line
end with

recordsetTABLE.close

EXIT ROUTINE B back to calling routine A
-----------------------------------------------------------------------------------------------

Ok - the problem is, that as it processes each day, the time taken
increases from less than 1 second perday to over 7 seconds for the
same amount of processing - ie each day contains the same (more or
less) amount of data

PLUS, when I quit the program, it takes an absolute age to return back
to the design environment.

So - the question is this: why is this happening and what can I do to
prevent it? When I am processing 8 tables with 365 entries in each
(2920 days in total) it gets stupidly long (a couple of hours) to
run.

I'm not using ODBC so I can't use the .StillExecuting to check on the
opening of the recordsets, though I have a feeling thtt it is this
which is causing the "lag" - opening and closing the tables - thhogh I
couldbe wrong.

I wondered if this was a limitation of the Jet database (mdb file) and
thought about using dbase V instead - but can't find how to use
CreateDatabase for dbaseV - I can open one fine - but I can't create
one. - any help on this please?

Should I erase the array one the data is saved?

Is ADO the only option?

Please help - this is driving me potty!!

Tym

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~
See http://www.ictis.net/no_spam.html for unsolicited email warning
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~

Tym

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~
See http://www.ictis.net/no_spam.html for unsolicited email warning
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~
Nov 12 '05 #1
Share this Question
Share on Google+
9 Replies


P: n/a
In the OpenRecordset call, be sure to include the dbAppendOnly option, since
that's all you're doing.
Nov 12 '05 #2

P: n/a
Tym,
Why not post the original code instead so we can all see it properly.
There maybe another way to do it still using DAO (also my prefered recordset
method).

There may also be an indexing issue on the original import table that stores
the 189000 records.
regs....

Nigel
"tym" <no**********************************************@ ictis.net> wrote in
message news:j8********************************@4ax.com...
HELP!!!

I'm going round the twist with this...

I have a VB6 application which is using DAO to access a database
(Please - no lectures on ADO, I know what I'm doing with DAO!!)

Ok, problem is this....

importing a large csv file (189000 lines, 7 fileds per line)

Import this into various tables fine - takes a a couple of minutes...
the problem is when I then process these tables.

The progam is basically split into 2
-------------------------------------------------------------------------- --------------------- Process A:
table name held in RECORDSETtables

For each table ( 0 - 6)

for each day (1 - 365)
call RoutineB(table,day)

next day

Next Table

RECORDSETtables.close

END

-------------------------------------------------------------------------- ---------------------
Routine B (sTABLE as string, sDATE as string)

set RecordsetTABLE = db.openrecordset(open table Day&date,
vbopendynaset)
if not error
table exists
exit routine
' don't need to process as data already exists
elseif
'create table to store data in later
end if

set RECORDSETdata = db.openrecordset(select data from sTABLE with
Specified sDate)

for each record in RECORDSETdata

long and itterative calcualtions.
store data in ARRAY(48,30)

next RECORDSETdata
close RECORDSETdata
with RecordsetTABLE
for each line in ARRAY(48,30)
.add new
.fields(1-48) = ARRAY(line,1-48)
.update
next line
end with

recordsetTABLE.close

EXIT ROUTINE B back to calling routine A
-------------------------------------------------------------------------- ---------------------
Ok - the problem is, that as it processes each day, the time taken
increases from less than 1 second perday to over 7 seconds for the
same amount of processing - ie each day contains the same (more or
less) amount of data

PLUS, when I quit the program, it takes an absolute age to return back
to the design environment.

So - the question is this: why is this happening and what can I do to
prevent it? When I am processing 8 tables with 365 entries in each
(2920 days in total) it gets stupidly long (a couple of hours) to
run.

I'm not using ODBC so I can't use the .StillExecuting to check on the
opening of the recordsets, though I have a feeling thtt it is this
which is causing the "lag" - opening and closing the tables - thhogh I
couldbe wrong.

I wondered if this was a limitation of the Jet database (mdb file) and
thought about using dbase V instead - but can't find how to use
CreateDatabase for dbaseV - I can open one fine - but I can't create
one. - any help on this please?

Should I erase the array one the data is saved?

Is ADO the only option?

Please help - this is driving me potty!!

Tym

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~
See http://www.ictis.net/no_spam.html for unsolicited email warning
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~
Tym

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~
See http://www.ictis.net/no_spam.html for unsolicited email warning

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~
Nov 12 '05 #3

P: n/a
tym
On 22 Nov 2003 15:53:01 GMT, dc****@aol.comSPNOAM (DCM Fan) wrote:
In the OpenRecordset call, be sure to include the dbAppendOnly option, since
that's all you're doing.


I need dynaset as I am using the absoluteposition and movefirst
movelast methods.
Tym

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~
See http://www.ictis.net/no_spam.html for unsolicited email warning
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~
Nov 12 '05 #4

P: n/a
tym
On Sat, 22 Nov 2003 16:06:33 -0000, "Nigel tombs"
<ic*****@tiscali.co.uk> wrote:
Tym,
Why not post the original code instead so we can all see it properly.
There maybe another way to do it still using DAO (also my prefered recordset
method).


Ok then...

Main process

---------------------------------------------------------------
Public Sub basTstCSV2Array()

Dim Idx As Long
Dim Jdx As Long
Dim Kdx As Long
Dim Ldx As Long
Dim FilNme As String
Dim MyArray As Variant
Dim T
Dim iProgress As Integer
Dim rsDUMP As Recordset
Dim rsSPLIT As Recordset
Dim bREPLACE As Boolean
Dim sStart As String
Dim sEND As String
Dim dLoop As Date

On Error GoTo Error_Trap
' sStart = "01/10/2002"
' sEND = "30/09/2003"
' GoTo SplitCore

mdiMAIN.CommonDialog1.DialogTitle = "Select Array File"
mdiMAIN.CommonDialog1.ShowOpen

FilNme = mdiMAIN.CommonDialog1.Filename
If FilNme = "" Then
Exit Sub
End If

DoEvents
mdiMAIN.StatusBar1.Panels(1) = "Loading..."
T = Timer
MyArray = basCSV2Array(FilNme)
'MsgBox Timer - T & " seconds"
Idx = UBound(MyArray, 1)
Jdx = UBound(MyArray, 2)
On Error Resume Next
dbGanieda.TableDefs.Delete ("DUMP")

On Error GoTo Error_Trap

Set rsDUMP = dbGanieda.OpenRecordset("DUMP", 2)

With rsDUMP
iProgress = 0
For Kdx = 0 To Idx
DoEvents
.AddNew

Do While 1 = 2
DoEvents
Loop
.Update
Do While 1 = 2
DoEvents
Loop
.MoveLast
Do While 1 = 2
DoEvents
Loop
If Int(100 * Kdx / Idx) > iProgress Then
iProgress = Int(100 * Kdx / Idx)
mdiMAIN.StatusBar1.Panels(1) = Format(iProgress, "0")
& " %"
End If
For Ldx = 0 To Jdx
If Ldx = 1 Then
If sStart = "" Then
sStart = Mid(MyArray(Kdx, Ldx), 2,
Len(MyArray(Kdx, Ldx)) - 2)
ElseIf CVDate(Mid(MyArray(Kdx, Ldx), 2,
Len(MyArray(Kdx, Ldx)) - 2)) < CVDate(sStart) Then
sStart = Mid(MyArray(Kdx, Ldx), 2,
Len(MyArray(Kdx, Ldx)) - 2)
End If

If sEND = "" Then
sEND = Mid(MyArray(Kdx, Ldx), 2,
Len(MyArray(Kdx, Ldx)) - 2)
ElseIf CVDate(Mid(MyArray(Kdx, Ldx), 2,
Len(MyArray(Kdx, Ldx)) - 2)) > CVDate(sEND) Then
sEND = Mid(MyArray(Kdx, Ldx), 2,
Len(MyArray(Kdx, Ldx)) - 2)
End If
End If
If Ldx = Jdx Then
If Not IsDate(Mid(MyArray(Kdx, Ldx), 2,
Len(MyArray(Kdx, Ldx)) - 2)) Then
Junk = "00" & Right(Mid(MyArray(Kdx, Ldx), 2,
Len(MyArray(Kdx, Ldx)) - 2), Len(Mid(MyArray(Kdx, Ldx), 2,
Len(MyArray(Kdx, Ldx)) - 2)))
Junk = Replace(Junk, " ", "0")
MyArray(Kdx, Ldx) = Chr(34) & Junk & Chr(34)
End If
End If
.Edit
.Fields(Ldx) = Mid(MyArray(Kdx, Ldx), 2,
Len(MyArray(Kdx, Ldx)) - 2)

Do While 1 = 2
DoEvents
Loop
.Update
Do While 1 = 2
DoEvents
Loop
Next Ldx

Next Kdx
.Close
End With

Debug.Print sStart; " > "; sEND
SplitCore:
mdiMAIN.StatusBar1.Panels(1) = "Splitting Core File..."

Crit = "SELECT DISTINCT ID FROM DUMP"

Set rsSPLIT = dbGanieda.OpenRecordset(Crit, 2)

Do Until rsSPLIT.EOF = True

mdiMAIN.StatusBar1.Panels(1) = rsSPLIT.AbsolutePosition
DoEvents
bREPLACE = True
Crit = "SELECT CVDate([event_date] & ' ' & [event_time]) AS
REALTIME, DUMP.EVENT_DATE, DUMP.EVENT_TIME, 0 AS ARRAY_TIME,
val(DUMP.CHANNEL) AS CHANNEL, DUMP.EVENT_TYPE, val(DUMP.LUX) AS LUX
INTO " & rsSPLIT.Fields("ID") & " FROM DUMP WHERE (((DUMP.ID)='" &
rsSPLIT.Fields("ID") & "'));"
Debug.Print Crit
dbGanieda.Execute Crit

rsSPLIT.MoveNext
Loop
rsSPLIT.MoveFirst
Do Until rsSPLIT.EOF = True
For dLoop = CVDate(sStart) To CVDate(sEND)
DoEvents
Call ChannelBurn(rsSPLIT.Fields("ID"), dLoop,
calcJD(year(dLoop), month(dLoop), day(dLoop)))
DBEngine.Idle dbRefreshCache
mdiMAIN.StatusBar1.Panels(1).Text = rsSPLIT.AbsolutePosition &
"/" & rsSPLIT.RecordCount & " " & dLoop & " - " & Timer - T

T = Timer
Debug.Print
Next dLoop
Debug.Print "Next Array..."

rsSPLIT.MoveNext
Loop
rsSPLIT.Close
dbGanieda.TableDefs.Delete ("DUMP")

mdiMAIN.StatusBar1.Panels(1) = ""

Exit Sub

Error_Trap:
Select Case Err.number
Case 3010
'table already exists
Err.Clear
Resp = MsgBox(rsSPLIT.Fields("ID") & " table already exists.
Replace?", vbQuestion + vbYesNo)
If Resp = vbYes Then
bREPLACE = True
dbGanieda.TableDefs.Delete (rsSPLIT.Fields("ID"))
Set rsTEMP = dbGanieda.OpenRecordset("EM", 2)
Do While 1 = 2
DoEvents
Loop

rsTEMP.AddNew
rsTEMP.Fields("CODE") = rsSPLIT.Fields("ID")
rsTEMP.Fields("PRIMARY_PECU") = rsSPLIT.Fields("ID")
rsTEMP.Fields("VERSION") = 0
rsTEMP.Fields("lat_deg") = 0
rsTEMP.Fields("lat_min") = 0
rsTEMP.Fields("long_deg") = 0
rsTEMP.Fields("long_min") = 0
rsTEMP.Update
Do While 1 = 2
DoEvents
Loop

Do While 1 = 2
DoEvents
Loop
rsTEMP.Close

Set rsTEMP = dbGanieda.OpenRecordset("PECUDETAILS", 2)
Do While 1 = 2
DoEvents
Loop

rsTEMP.AddNew
rsTEMP.Fields("CODE") = rsSPLIT.Fields("ID")
rsTEMP.Fields("VERSION") = 0
rsTEMP.Update
Do While 1 = 2
DoEvents
Loop

Do While 1 = 2
DoEvents
Loop

rsTEMP.Close
Resume
Else
bREPLACE = False
Resume Next
End If

Case 3021
'no data in table
MsgBox "No data in table - why is this triggered???"
'debug.Print "pass???"
Resume

Case 3078
'create table


Dim TDF As TableDef
Dim fldFIELD As Field

Set TDF = dbGanieda.CreateTableDef("DUMP")

' Add fields to TDF.

Set fldFIELD = TDF.CreateField("ID", dbText, 13)
TDF.Fields.Append fldFIELD
Set fldFIELD = TDF.CreateField("EVENT_DATE", dbText, 13)
TDF.Fields.Append fldFIELD
Set fldFIELD = TDF.CreateField("CHANNEL", dbInteger)
TDF.Fields.Append fldFIELD
Set fldFIELD = TDF.CreateField("EVENT_TYPE", dbText, 13)
TDF.Fields.Append fldFIELD
Set fldFIELD = TDF.CreateField("LUX", dbInteger)
TDF.Fields.Append fldFIELD
Set fldFIELD = TDF.CreateField("NULL", dbText, 13)
fldFIELD.AllowZeroLength = True
TDF.Fields.Append fldFIELD
Set fldFIELD = TDF.CreateField("EVENT_TIME", dbText, 13)
TDF.Fields.Append fldFIELD

' Save TableDef definition by appending it to TableDefs
collection.
dbGanieda.TableDefs.Append TDF


Resume

Case Else
MsgBox Err.number & ": " & Err.Description & " " & Err.Source
Err.Clear
'clear this
Resume
End Select


End Sub

---------------------------------------------------------------

"Process B"

--------------------------------------------------------------
Sub ChannelBurn(PecuArray As String, EvDate As Date, JulianDay As
Double)
Dim jDAy As Long
Dim BurnTotal As Double
Dim rsJUNK As Recordset
Dim rsFilter As Recordset
Dim Last_Day As Date
Dim Last_Period As Integer
Dim Last_Event As String
Dim Period As Integer
Dim EventTimeDec As Double
Dim SearchDate As String
Dim TotalEvents As Integer
Dim J As Integer
Dim T
Dim aJUNK() As Variant
Dim lNoRecords As Long
Dim iNoFields As Integer
Dim iLOOP As Integer
Dim rsSAVE As Recordset
Dim TDF As TableDef
'debug.Print PecuArray, EvDate, JulianDay
IconData.szTip = "Ganieda is calculating channel burn times" & Chr(0)
Shell_NotifyIcon NIM_MODIFY, IconData

If JulianDay = calcJD(year(Now), month((GMT)), day(Now)) Then
'can't cac for today
Exit Sub
End If
jDAy = JulianDay * 100

Erase hours

JulianDay = Int(JulianDay)

On Error GoTo Error_Trap
'check to see if burn table already exists...
'Crit = "select * from [" & Trim(PecuArray) & "_" & Trim(Str(jDAy)) &
"]"
'debug.Print Crit
'Error_Flag = False
'Set rsJUNK = dbGanieda.OpenRecordset(Crit, dbOpenDynaset)
'If Error_Flag = False Then
' 'table already exists
' Exit Sub
'End If
'Set rsJUNK = Nothing
'rsJUNK.Close
Flag = False
For Each TDF In dbGanieda.TableDefs
Crit = Trim(PecuArray) & "_" & Trim(Str(jDAy))
If TDF.Name = Crit Then
Exit Sub
End If
Next TDF

'If Flag = True Then ' FLAG will be set when corrective calculation is
carried out
' GoTo No_Table ' therefore, need to re-calculate the channel
burn
'End If
'table exists - no need to calculate
'Exit Sub

No_Table:

SearchDate = Format(day(EvDate), "00") & "/" & Format(month(EvDate),
"00") & "/" & Format(year(EvDate), "00")

'Crit = "SELECT * from [" & PecuArray & "] where EVENT_DATE = '" &
SearchDate & "' order by channel, realtime"
'debug.Print Crit
T = Timer
If DeadArrayFlag Then
'unable to contact array = set burns to 9999
For i = 1 To 30
For J = 0 To 47
hours(J, i) = 9999
Next J
Next i
GoTo Save_It
End If
'Debug.Print "PART 1: "; Timer - T
T = Timer
Erase hours()

For i = 1 To 30
DoEvents
TotalEvents = 0
' For J = 0 To 47
' hours(J, i) = 0
' Next J

'Debug.Print "PART A: "; Timer - T

T = Timer
Error_Flag = False
Crit = "SELECT * from [" & PecuArray & "] where EVENT_DATE = '" &
SearchDate & "' and channel = " & i & " order by channel, realtime"
''debug.Print Crit
Set rsJUNK = dbGanieda.OpenRecordset(Crit, 2)
Do While 1 = 2
DoEvents
Loop

rsJUNK.MoveLast
If Error_Flag Then GoTo Blank_Channel
'debug.Print "Channel "; i; " = "; rsJUNK.RecordCount

rsJUNK.MoveFirst
lNoRecords = rsJUNK.RecordCount - 1
iNoFields = rsJUNK.Fields.Count - 1

ReDim aJUNK(lNoRecords, iNoFields)
'Debug.Print "Loading rs into array"
T = Timer
With rsJUNK
Do Until .EOF = True
For iLOOP = 0 To iNoFields
aJUNK(.AbsolutePosition, iLOOP) = .Fields(iLOOP)
Next iLOOP
'For iLOOP = 0 To iNoFields: Debug.Print
aJUNK(.AbsolutePosition, iLOOP); ", ";: Next iLOOP: Debug.Print
.MoveNext
Loop
End With
rsJUNK.Close

'Debug.Print Timer - t; "seconds to load"
'With rsJUNK

'Do Until .EOF = True
For iLOOP = 0 To lNoRecords
T = Timer
If iLOOP = 0 Then
' 1st record in recordset
Last_Day = EvDate
Last_Period = 0
If aJUNK(iLOOP, 5) = "ON" Then
Last_Event = "OF"
TotalEvents = TotalEvents + 1
ElseIf aJUNK(iLOOP, 5) = "OF" Then
Last_Event = "ON"
TotalEvents = TotalEvents + 1
End If
End If

If Last_Day <> EvDate Then
'a day or more has elapsed between events
'debug.Print "NEED TO CODE THIS"
End If

' convert time to a decimal value
EventTimeDec = Hour(aJUNK(iLOOP, 0)) +
(Minute(aJUNK(iLOOP, 0)) / 60)

Period = Floor(EventTimeDec, 0.5) / 0.5
'debug.Print "Channel "; i; ": Event "; ajunk(iloop,5); "
occurs in period "; Period
If EventTimeDec = 0 Then
Period = 1
End If

If Period <> Last_Period Then
If Last_Event = "ON" Then
hours(Last_Period, i) = 0.5 + hours(Last_Period,
i)
End If
If Period - Last_Period > 1 Then
For J = Last_Period + 1 To Period - 1
If Last_Event = "OF" Then
hours(J, i) = 0
ElseIf Last_Event = "ON" Then
hours(J, i) = 0.5
End If
Next J
End If
End If
If aJUNK(iLOOP, 5) = "ON" Then
If aJUNK(iLOOP, 6) = 9999 Then
hours(Period, i) = 9999
ElseIf aJUNK(iLOOP, 6) < rsSystem.Fields("MAX_LUX")
Then
If Last_Event <> "ON" Then
hours(Period, i) = hours(Period, i) -
((EventTimeDec - (Period * 0.5)))
End If
End If
ElseIf aJUNK(iLOOP, 5) = "OF" Then
If aJUNK(iLOOP, 6) = 9999 Then
hours(Period, i) = 9999
ElseIf aJUNK(iLOOP, 6) > rsSystem.Fields("MIN_LUX")
Then
If Last_Event <> "OF" Then
hours(Period, i) = hours(Period, i) +
((EventTimeDec - (Period * 0.5)))
End If
End If
ElseIf aJUNK(iLOOP, 5) = "TA" Then
For J = 0 To 47
hours(J, i) = 9999
GoTo MoveNext
GoTo Blank_Channel
Next J
End If

Last_Period = Period
Last_Event = aJUNK(iLOOP, 5)

GoTo MoveNext
DoEvents
'debug.Print iloop; " time taken: "; Timer - T
'loop
MoveNext:
Next iLOOP
'.Close
'End With
'Debug.Print "PART B: "; Timer - T
T = Timer

If Last_Event = "ON" Then
hours(Last_Period, i) = 0.5 + hours(Last_Period, i)
End If

If 47 - Last_Period > 1 Then
If Last_Event = "OF" Then
For J = Last_Period + 1 To 47
hours(J, i) = 0
Next J
ElseIf Last_Event = "ON" Then
For J = Last_Period + 1 To 47
hours(J, i) = 0.5
Next J
End If
End If

'dbGanieda.TableDefs.Refresh
'Debug.Print "PART c: "; Timer - T
T = Timer

BurnTotal = 0

For J = 0 To 47
'debug.Print hours(J, i); " ";
BurnTotal = BurnTotal + hours(J, i)
Next J

'Debug.Print "PART D: "; Timer - T
T = Timer
If TotalEvents > rsSystem.Fields("MAX_EVENTS") Then
'too many events recorded for that day
If CmdLine = "DIAL" Then
WriteToFile ("Max events exceeded for channel " &
Trim(Str(i)) & " on Array " & PecuArray)
End If
For J = 0 To 47
hours(J, i) = 9999
Next J
End If

'Debug.Print "PART E: "; Timer - T
T = Timer

If BurnTotal < 1 Then
'insufficent data collected - flag as error
For J = 0 To 47
hours(J, i) = 9999
Next J
End If

Blank_Channel:

On Error Resume Next
rsJUNK.Close
On Error GoTo Error_Trap
Next i
'Debug.Print "PART 2: "; Timer - T
T = Timer
On Error Resume Next
Save_It:

'Debug.Print "PART F: "; Timer - T
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
T = Timer

Call SaveIt(PecuArray, jDAy, hours())
'Debug.Print "PART 3: "; Timer - T
T = Timer
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------

Exit Sub
'--------------------------------------------------------------------------
Error_Trap:
Select Case Err.number
Case 3021
'no record
Err.Clear
Error_Flag = True
Resume Next

Case 3078
Err.Clear
'Great! Table does not exist
' can proceed with calcs
' need to make table for this session though....
Dim myTableDef As TableDef, MyField As Field
Set myTableDef = dbGanieda.CreateTableDef(PecuArray & "_" &
Trim(Str(jDAy))) ', dbHiddenObject)
For J = 0 To 47
Set MyField = myTableDef.CreateField("PERIOD_" & Trim(Str(J)),
dbDouble)
myTableDef.Fields.Append MyField
Next J
' Save TableDef definition by appending it to TableDefs
collection.
dbGanieda.TableDefs.Append myTableDef
'''debug.Print "UserLog Table Created"
dbGanieda.TableDefs.Refresh

Resume No_Table
Case Else
If CmdLine = "DIAL" Then
WriteToFile ("Channel Burn: " & Err.number & " " &
Err.Description & " " & Err.Source & " " & PecuArray & " " & EvDate &
" " & JulianDay)
End If
MsgBox "Channel Burn: " & Err.number & " " & Err.Description & " "
& Err.Source
Err.Clear
Resume
End Select

End Sub
-------------------------------------------------------------------
Tym

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~
See http://www.ictis.net/no_spam.html for unsolicited email warning
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~
Nov 12 '05 #5

P: n/a
TC

"tym" <no**********************************************@ ictis.net> wrote in
message news:0t********************************@4ax.com...

(snip)
Do While 1 = 2
DoEvents
Loop


Huh?

TC

Nov 12 '05 #6

P: n/a
tym
On Sun, 23 Nov 2003 14:38:28 +1200, "TC" <a@b.c.d> wrote:
Do While 1 = 2
DoEvents
Loop


Huh?


Yeah! This occurs in several places. I had a routine in place:

Do While .StillExecuting
DoEvents
Loop

to see if that would help but...

But when I ran it it didnt't work - I wasn't using ODBC therefore the
..SE wouldn't work, so instead of going through dozens of these and
deleting them, I just chaged it to 1=2 for the time being - will take
it out when the problem is solved!!! :-)

Tym

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~
See http://www.ictis.net/no_spam.html for unsolicited email warning
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~

Nov 12 '05 #7

P: n/a
rkc

"TC" <a@b.c.d> wrote in message news:1069560500.340056@teuthos...

"tym" <no**********************************************@ ictis.net> wrote in message news:0t********************************@4ax.com...

(snip)
Do While 1 = 2
DoEvents
Loop


Huh?


I'll see your "Huh?" and raise you a "Yowza!"
Nov 12 '05 #8

P: n/a
tym
On Sun, 23 Nov 2003 13:56:31 GMT, "rkc"
<rk*@yabba.dabba.do.rochester.rr.bomb> wrote:

I'll see your "Huh?" and raise you a "Yowza!"


Constructive comments always welcome!

Tym

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~
See http://www.ictis.net/no_spam.html for unsolicited email warning
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~
Nov 12 '05 #9

P: n/a
rkc

"tym" <no**********************************************@ ictis.net> wrote in
message news:1f********************************@4ax.com...
On Sun, 23 Nov 2003 13:56:31 GMT, "rkc"
<rk*@yabba.dabba.do.rochester.rr.bomb> wrote:

I'll see your "Huh?" and raise you a "Yowza!"


Constructive comments always welcome!


I'm sorry. You're absolutely right.

The only thing constructive I can come up with is to suggest that
you adopt some procedural programming techniques.

Code Complete is still a great book.



Nov 12 '05 #10

This discussion thread is closed

Replies have been disabled for this discussion.