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!
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