Big problem with form PLEASE HELP


J

James

This will be long winded but please bear with me: I need some help. I have
an access program with will take the information from my DB2 database from
and AIX system and copy it to a table in access. Everything has been
working fine until hurricane Gustav. during that time (from 8/29 - 9/3) the
database did not update. On 9/4 - 9/8, after rebooting the access pc the
updates continued to work. it again died on 9/9 - present.
Part of the script checks for the reports (known as CFS) at 6:00 AM each
morning and pulls the information from the previous day (i.e. on 8/2 it
pulls info from 8/1). If you look at some the comments in the text below, i
can change the date and CFS # to pull the previous day if it does not run
overnight for whatever reason. In doing so, I can't get it to pull any
information. I can go to the DB2 system and pull all the CFS for the dates
I'm missing so I know the data is there. Please let me know if there is
something simple I am missing or if there is a simple correction needed to
be made to fix this issue. The code is below.

Option Compare Database



Private Sub Detail_Click()



End Sub



Private Sub firstday_BeforeUpdate(Cancel As Integer)



End Sub



Private Sub Form_Load()

Dim day1

'day1 = Now()

'to add a missing date change day1 to 1 day before todays date

'if today is 10/18/2007, change day1 to day1 = #10/17/2007#

day1 = "09/02/2008 6:00 am"

day1 = DateValue(day1) & " 6:00 am"

Me.firstday = day1

day1 = 0

End Sub



Private Sub Form_Timer()

Dim cadstampdate, cadstamptime, primary, cfs, code, incadd, dispo, dispatch,
calltaker, item, last4, getcfs, officer

Dim sqlfull, dbsfull, rstfull

Dim sqlfull_sub, dbsfull_sub, rstfull_sub

Dim sqlfull_cfs, dbsfull_cfs, rstfull_cfs

Dim sqlfull_item, dbsfull_item, rstfull_item

Dim sqldb2_dr, dbsdb2_dr, rstdb2_dr

Dim sqldb2_cfs, dbsdb2_cfs, rstdb2_cfs

Dim sqldb2_sub, dbsdb2_sub, rstdb2_sub

Dim count, todayhr, mm, dd, yy, day1, day2

Dim stDocName As String



'put a stop on me.timerinterval. to put stop click on the

'left side bar and put a red dot on it. hit F8 to advance to

'next line and hit F5 to continue.

Me.TimerInterval = 0



todayhr = Now()

todayhr = Hour(todayhr)

day1 = Me.firstday

day2 = Now()

If DateDiff("d", day1, day2) >= 1 Then

If todayhr = "9" Then

getcfs = DateAdd("d", -1, Trim(Now()))

If Month(getcfs) < 10 Then

mm = "0" & Left(getcfs, 1)

If Day(getcfs) < 10 Then

dd = "0" & Mid(getcfs, 3, 1)

yy = Mid(getcfs, 7, 2)

Else

dd = Mid(getcfs, 3, 2)

yy = Mid(getcfs, 8, 2)

End If

Else

mm = Left(getcfs, 2)

If Day(getcfs) < 10 Then

dd = "0" & Mid(getcfs, 4, 1)

yy = Mid(getcfs, 8, 2)

Else

dd = Mid(getcfs, 4, 2)

yy = Mid(getcfs, 9, 2)

End If

End If

'just flip the ' between the 2 and enter the date you want to append

'in the slot if want 10/13/2007 use getcfs = "101307-*"

getcfs = "090308-*"

'getcfs = mm & dd & yy & "-*"

GoSub gofullitem

GoSub gofullcfs

GoSub gofullsub

GoSub fullimport

Me.firstday = day2

Me.secondday = Now()

End If

End If



Me.TimerInterval = 9999

Exit Sub





gofullitem:

sqlfull_item = "SELECT full_item.item, full_item.cfs from full_item;"

Set dbsfull_item = CurrentDb

Set rstfull_item = dbsfull_item.OpenRecordset(sqlfull_item)

GoSub goitem

dbsfull_item.Close

Set rstfull_item = Nothing

Set recfull_item = Nothing

Return

Exit Sub





goitem:

sqldb2_drn = "SELECT KENADM_CADDRNDB2.DR_NMBR, KENADM_CADDRNDB2.drn_NMBR
FROM KENADM_CADDRNDB2 where kenadm_caddrndb2.drn_nmbr like " & Chr(34) &
getcfs & Chr(34) & ";"

Set dbsdb2_drn = CurrentDb

Set rstdb2_drn = dbsdb2_drn.OpenRecordset(sqldb2_drn)

count = rstdb2_drn.RecordCount

Do While rstdb2_drn.EOF = False

cfs = rstdb2_drn![drn_nmbr]

item = Trim(rstdb2_drn![dr_nmbr])

If mm < 10 Then

item = Mid([item], 14, 2) & "0" & Mid([item], 16, 1) & Right([item],
5)

Else

item = Mid([item], 13, 2) & Mid([item], 15, 2) & Right([item], 5)

End If

rstfull_item.AddNew

rstfull_item![item] = item

rstfull_item![cfs] = cfs

rstfull_item.update

item = ""

cfs = ""

rstdb2_drn.MoveNext

Loop

dbsdb2_drn.Close

Set rstdb2_drn = Nothing

Set recdb2_drn = Nothing

Return

Exit Sub





gofullcfs:

sqlfull_cfs = "SELECT full_cfs.cfs, full_cfs.code, full_cfs.address,
full_cfs.apt, full_cfs.call_taker, full_cfs.dispatcher, full_cfs.primary,
full_cfs.dispo, full_cfs.stampdate, full_cfs.stamptime from full_cfs;"

Set dbsfull_cfs = CurrentDb

Set rstfull_cfs = dbsfull_cfs.OpenRecordset(sqlfull_cfs)

GoSub gocfs

dbsfull_cfs.Close

Set rstfull_cfs = Nothing

Set recfull_cfs = Nothing

Return

Exit Sub





gocfs:

sqldb2_cfs = "SELECT KENADM_CADCFSDB2.CFS_NUMBR,
KENADM_CADCFSDB2.INC_CODE, KENADM_CADCFSDB2.ADDRESS,
KENADM_CADCFSDB2.APT_NUMBER, KENADM_CADCFSDB2.CALL_TAKER,
KENADM_CADCFSDB2.DISPATCHER, KENADM_CADCFSDB2.PRIUNIT,
KENADM_CADCFSDB2.FINALDISP, KENADM_CADCFSDB2.STMP_RCVD FROM KENADM_CADCFSDB2
where KENADM_CADCFSDB2.CFS_NUMBR like " & Chr(34) & getcfs & Chr(34) & ";"

Set dbsdb2_cfs = CurrentDb

Set rstdb2_cfs = dbsdb2_cfs.OpenRecordset(sqldb2_cfs)

count = rstdb2_cfs.RecordCount

rstdb2_cfs.MoveFirst

Do While rstdb2_cfs.EOF = False



cfs = Trim(rstdb2_cfs![cfs_numbr])

code = Trim(rstdb2_cfs![INC_CODE])

Address = Trim(rstdb2_cfs![Address])

apt = Trim(rstdb2_cfs![APT_NUMBER])

calltaker = Trim(rstdb2_cfs![call_taker])

dispatch = Trim(rstdb2_cfs![dispatcher])

primary = Trim(rstdb2_cfs![PRIUNIT])

dispo = Trim(rstdb2_cfs![FINALDISP])

cadstampdate = Left((rstdb2_cfs![stmp_rcvd]), 10)

cadstamptime = Mid((rstdb2_cfs![stmp_rcvd]), 12, 5)

cadstampdate = Mid(cadstampdate, 6, 2) & "/" & Mid(cadstampdate, 9, 2) &
"/" & Left(cadstampdate, 4)

rstfull_cfs.AddNew

rstfull_cfs![cfs] = cfs

rstfull_cfs!
Code:
 = code

rstfull_cfs![Address] = Address

rstfull_cfs![apt] = apt

rstfull_cfs![call_taker] = calltaker

rstfull_cfs![dispatcher] = dispatch

rstfull_cfs![primary] = primary

rstfull_cfs![dispo] = dispo

rstfull_cfs![stampdate] = cadstampdate

rstfull_cfs![stamptime] = cadstamptime

rstfull_cfs.update

cfs = ""

code = ""

Address = ""

apt = ""

calltaker = ""

dispatch = ""

primary = ""

dispo = ""

cadstampdate = ""

cadstamptime = ""

rstdb2_cfs.MoveNext

Loop

dbsdb2_cfs.Close

Set rstdb2_cfs = Nothing

Set recdb2_cfs = Nothing

Return

Exit Sub





gofullsub:

sqlfull_sub = "SELECT full_sub.unit, full_sub.last4, full_sub.name, 
full_sub.cfs from full_sub;"

Set dbsfull_sub = CurrentDb

Set rstfull_sub = dbsfull_sub.OpenRecordset(sqlfull_sub)

GoSub gounit

dbsfull_sub.Close

Set rstfull_sub = Nothing

Set recfull_sub = Nothing

Return

Exit Sub





gounit:

sqldb2_sub = "SELECT KENADM_CADSUBDB2.unt_number, 
KENADM_CADSUBDB2.sub_unit_id, KENADM_CADSUBDB2.sub_unit_desc, 
KENADM_CADSUBDB2.cfs_numbr from KENADM_CADSUBDB2 where 
KENADM_CADSUBDB2.cfs_numbr like " & Chr(34) & getcfs & Chr(34) & ";"

Set dbsdb2_sub = CurrentDb

Set rstdb2_sub = dbsdb2_sub.OpenRecordset(sqldb2_sub)

count = rstdb2_sub.RecordCount



Do While rstdb2_sub.EOF = False

primary = rstdb2_sub![unt_number]

cfs = rstdb2_sub![cfs_numbr]

last4 = rstdb2_sub![sub_unit_id]

officer = rstdb2_sub![sub_unit_desc]



rstfull_sub.AddNew

rstfull_sub![unit] = primary

rstfull_sub![cfs] = cfs

rstfull_sub![last4] = last4

rstfull_sub![Name] = officer



rstfull_sub.update

primary = ""

cfs = ""

officer = ""

last4 = ""

rstdb2_sub.MoveNext

Loop

dbsdb2_sub.Close

Set rstdb2_sub = Nothing

Set recdb2_sub = Nothing

Return

Exit Sub



fullimport:

Application.SetOption "confirm action queries", 0

Application.SetOption "confirm record changes", 0

Application.SetOption "confirm document deletions", 0



stDocName = "appendfull"

DoCmd.OpenQuery stDocName, acNormal, acEdit

stDocName = "updateunit"

DoCmd.OpenQuery stDocName, acNormal, acEdit

stDocName = "deletecfs"

DoCmd.OpenQuery stDocName, acNormal, acEdit

stDocName = "deletesub"

DoCmd.OpenQuery stDocName, acNormal, acEdit

stDocName = "deleteitem"

DoCmd.OpenQuery stDocName, acNormal, acEdit

stDocName = "updateshift"

DoCmd.OpenQuery stDocName, acNormal, acEdit

stDocName = "latechecker"

DoCmd.OpenQuery stDocName, acNormal, acEdit



Application.SetOption "confirm action queries", 1

Application.SetOption "confirm record changes", 1

Application.SetOption "confirm document deletions", 1

Return

Exit Sub



End Sub
 
Ad

Advertisements

J

Jerry Whittle

Something simple would be with all the shutdowns, the system clock on the PC
holding the database is set to the wrong date. Or maybe even the AIX system
has date/time problems.
--
Jerry Whittle, Microsoft Access MVP
Light. Strong. Cheap. Pick two. Keith Bontrager - Bicycle Builder.


James said:
This will be long winded but please bear with me: I need some help. I have
an access program with will take the information from my DB2 database from
and AIX system and copy it to a table in access. Everything has been
working fine until hurricane Gustav. during that time (from 8/29 - 9/3) the
database did not update. On 9/4 - 9/8, after rebooting the access pc the
updates continued to work. it again died on 9/9 - present.
Part of the script checks for the reports (known as CFS) at 6:00 AM each
morning and pulls the information from the previous day (i.e. on 8/2 it
pulls info from 8/1). If you look at some the comments in the text below, i
can change the date and CFS # to pull the previous day if it does not run
overnight for whatever reason. In doing so, I can't get it to pull any
information. I can go to the DB2 system and pull all the CFS for the dates
I'm missing so I know the data is there. Please let me know if there is
something simple I am missing or if there is a simple correction needed to
be made to fix this issue. The code is below.

Option Compare Database



Private Sub Detail_Click()



End Sub



Private Sub firstday_BeforeUpdate(Cancel As Integer)



End Sub



Private Sub Form_Load()

Dim day1

'day1 = Now()

'to add a missing date change day1 to 1 day before todays date

'if today is 10/18/2007, change day1 to day1 = #10/17/2007#

day1 = "09/02/2008 6:00 am"

day1 = DateValue(day1) & " 6:00 am"

Me.firstday = day1

day1 = 0

End Sub



Private Sub Form_Timer()

Dim cadstampdate, cadstamptime, primary, cfs, code, incadd, dispo, dispatch,
calltaker, item, last4, getcfs, officer

Dim sqlfull, dbsfull, rstfull

Dim sqlfull_sub, dbsfull_sub, rstfull_sub

Dim sqlfull_cfs, dbsfull_cfs, rstfull_cfs

Dim sqlfull_item, dbsfull_item, rstfull_item

Dim sqldb2_dr, dbsdb2_dr, rstdb2_dr

Dim sqldb2_cfs, dbsdb2_cfs, rstdb2_cfs

Dim sqldb2_sub, dbsdb2_sub, rstdb2_sub

Dim count, todayhr, mm, dd, yy, day1, day2

Dim stDocName As String



'put a stop on me.timerinterval. to put stop click on the

'left side bar and put a red dot on it. hit F8 to advance to

'next line and hit F5 to continue.

Me.TimerInterval = 0



todayhr = Now()

todayhr = Hour(todayhr)

day1 = Me.firstday

day2 = Now()

If DateDiff("d", day1, day2) >= 1 Then

If todayhr = "9" Then

getcfs = DateAdd("d", -1, Trim(Now()))

If Month(getcfs) < 10 Then

mm = "0" & Left(getcfs, 1)

If Day(getcfs) < 10 Then

dd = "0" & Mid(getcfs, 3, 1)

yy = Mid(getcfs, 7, 2)

Else

dd = Mid(getcfs, 3, 2)

yy = Mid(getcfs, 8, 2)

End If

Else

mm = Left(getcfs, 2)

If Day(getcfs) < 10 Then

dd = "0" & Mid(getcfs, 4, 1)

yy = Mid(getcfs, 8, 2)

Else

dd = Mid(getcfs, 4, 2)

yy = Mid(getcfs, 9, 2)

End If

End If

'just flip the ' between the 2 and enter the date you want to append

'in the slot if want 10/13/2007 use getcfs = "101307-*"

getcfs = "090308-*"

'getcfs = mm & dd & yy & "-*"

GoSub gofullitem

GoSub gofullcfs

GoSub gofullsub

GoSub fullimport

Me.firstday = day2

Me.secondday = Now()

End If

End If



Me.TimerInterval = 9999

Exit Sub





gofullitem:

sqlfull_item = "SELECT full_item.item, full_item.cfs from full_item;"

Set dbsfull_item = CurrentDb

Set rstfull_item = dbsfull_item.OpenRecordset(sqlfull_item)

GoSub goitem

dbsfull_item.Close

Set rstfull_item = Nothing

Set recfull_item = Nothing

Return

Exit Sub





goitem:

sqldb2_drn = "SELECT KENADM_CADDRNDB2.DR_NMBR, KENADM_CADDRNDB2.drn_NMBR
FROM KENADM_CADDRNDB2 where kenadm_caddrndb2.drn_nmbr like " & Chr(34) &
getcfs & Chr(34) & ";"

Set dbsdb2_drn = CurrentDb

Set rstdb2_drn = dbsdb2_drn.OpenRecordset(sqldb2_drn)

count = rstdb2_drn.RecordCount

Do While rstdb2_drn.EOF = False

cfs = rstdb2_drn![drn_nmbr]

item = Trim(rstdb2_drn![dr_nmbr])

If mm < 10 Then

item = Mid([item], 14, 2) & "0" & Mid([item], 16, 1) & Right([item],
5)

Else

item = Mid([item], 13, 2) & Mid([item], 15, 2) & Right([item], 5)

End If

rstfull_item.AddNew

rstfull_item![item] = item

rstfull_item![cfs] = cfs

rstfull_item.update

item = ""

cfs = ""

rstdb2_drn.MoveNext

Loop

dbsdb2_drn.Close

Set rstdb2_drn = Nothing

Set recdb2_drn = Nothing

Return

Exit Sub





gofullcfs:

sqlfull_cfs = "SELECT full_cfs.cfs, full_cfs.code, full_cfs.address,
full_cfs.apt, full_cfs.call_taker, full_cfs.dispatcher, full_cfs.primary,
full_cfs.dispo, full_cfs.stampdate, full_cfs.stamptime from full_cfs;"

Set dbsfull_cfs = CurrentDb

Set rstfull_cfs = dbsfull_cfs.OpenRecordset(sqlfull_cfs)

GoSub gocfs

dbsfull_cfs.Close

Set rstfull_cfs = Nothing

Set recfull_cfs = Nothing

Return

Exit Sub





gocfs:

sqldb2_cfs = "SELECT KENADM_CADCFSDB2.CFS_NUMBR,
KENADM_CADCFSDB2.INC_CODE, KENADM_CADCFSDB2.ADDRESS,
KENADM_CADCFSDB2.APT_NUMBER, KENADM_CADCFSDB2.CALL_TAKER,
KENADM_CADCFSDB2.DISPATCHER, KENADM_CADCFSDB2.PRIUNIT,
KENADM_CADCFSDB2.FINALDISP, KENADM_CADCFSDB2.STMP_RCVD FROM KENADM_CADCFSDB2
where KENADM_CADCFSDB2.CFS_NUMBR like " & Chr(34) & getcfs & Chr(34) & ";"

Set dbsdb2_cfs = CurrentDb

Set rstdb2_cfs = dbsdb2_cfs.OpenRecordset(sqldb2_cfs)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top