VBA Code

G

Guest

I have been working on this database for a while now to get it to work with
my info.I dont know enough about vba to know what Im looking for. It was
inherited from a previous admin, the problem that Im having is that when the
module finishes I dont get any results in the running table? I can not figure
it out, the rest of the table seem to fill in properly except on table shows
me to different months when there should only be one! This database is used
for keeping track of our clients alarms so we can bill accordingly.

Option Compare Database
Dim db As DAO.Database
Dim rsSheet1 As DAO.Recordset
Dim rsTotalfull As DAO.Recordset
Dim rsRunning As DAO.Recordset

Public Sub clovis()
Dim slocation As String, saddress As String, slocation2 As String, saddress2
As String
Dim sdate As String, sSql As String, sdatenew As String, samount As String
Dim incident As Integer
Dim count As Integer


On Error GoTo ErrorHandler
Set db = CurrentDb()

'Loads TEMP to parse and concatenate dates
DoCmd.OpenQuery "TEMP-Empty", acViewNormal, acEdit 'empty temp table
DoCmd.OpenQuery "TEMP-Load", acViewNormal, acEdit 'Loads temp table with
date parsed
DoCmd.OpenQuery "TEMP-Update", acViewNormal, acEdit 'concatenates date with
format

'Loads Lookup to scrub the location and address for matches
DoCmd.OpenQuery "Lookup-Load", acViewNormal, acEdit 'Loads lookup to validate
MsgBox ("Validate Locations in Lookup Table")

'Load all records through scrubbed Lookup table for correct locations and
addresses
DoCmd.OpenQuery "Sheet1-Empty", acViewNormal, acEdit 'empty sheet1 table
DoCmd.OpenQuery "Sheet1-Load", acViewNormal, acEdit 'Loads sheet1 table with
all data

'Load only 1 (last) record to the table for updating all dates
DoCmd.OpenQuery "Sheet2-Empty", acViewNormal, acEdit 'empty sheet2 table
DoCmd.OpenQuery "Sheet2-Append1record", acViewNormal, acEdit 'Loads sheet2
table with all data

'Load locations to the totals table
DoCmd.OpenQuery "TOTAL-LOAD", acViewNormal, acEdit 'Loads Total table with
all data

'Load the Incident table with totals after clear
DoCmd.OpenQuery "Incident-Empty", acViewNormal, acEdit 'empty Incident table
DoCmd.OpenQuery "Incident-Load", acViewNormal, acEdit 'Loads Incident table
with all data

MsgBox ("Change Query:'Total-Update(Incident)' to the correct month")

'Update incident to totals table with the amount of incidents per location
(all locations in now)
DoCmd.OpenQuery "Total-Update(Incident)", acViewNormal, acEdit 'Loads
Incident table with all data

'Load all records for history purposes
DoCmd.OpenQuery "Total_Full-Load", acViewNormal, acEdit 'Load all records

'Update totals for all incidents in Total_Full table
DoCmd.OpenQuery "Total-Update(Totals)", acViewNormal, acEdit 'Update all
records

'Sheet2 update total incidents from Totals table
DoCmd.OpenQuery "Sheet2-Update(Incidents)", acViewNormal, acEdit

'Load RUNNING table for adding amounts and incidents after date field
DoCmd.OpenQuery "RUNNING-Empty", acViewNormal, acEdit
DoCmd.OpenQuery "RUNNING-Load", acViewNormal, acEdit

'Puts the number of incidents and total amount due for each incident after
the date field.
Set rsSheet1 = CurrentDb.OpenRecordset("SELECT * from Sheet1 ORDER BY
address, location, last_date")
Set rsRunning = CurrentDb.OpenRecordset("SELECT * from RUNNING ORDER BY
address, location")
Set rsTotalfull = CurrentDb.OpenRecordset("SELECT * from Total_Full ORDER BY
address, location, date")


If Not rsRunning.EOF Then rsRunning.MoveFirst
Do Until rsRunning.EOF
slocation = rsRunning!location
saddress = rsRunning!address
sdate = rsRunning!Date
incident = rsRunning!INCIDENT_TOTALS - rsRunning!incident
count = 1
If incident < 4 And incident <> 0 Then
rsTotalfull.MoveFirst
incident = 1
Do Until rsTotalfull.EOF
If slocation = rsTotalfull!location And saddress =
rsTotalfull!address Then
samount = IIf(incident = 1, "0", IIf(incident = 2, "0",
IIf(incident = 3, "100", IIf(incident = 4, "100", IIf(incident = 5, "100",
"250")))))
sdate = rsTotalfull!Date
sdatenew = sdate & " #" & incident & " $" & samount
sSql = "UPDATE Running INNER JOIN TOTAL_FULL ON
(Running.ADDRESS = TOTAL_FULL.ADDRESS) AND (Running.LOCATION =
TOTAL_FULL.LOCATION) " & _
"SET Running.DATE_" & count & " = '" & sdatenew &
"'" & _
"WHERE Total_Full.[ADDRESS] = '" & saddress & "' AND
Total_Full.[LOCATION] = '" & slocation & "'"
DoCmd.RunSQL sSql
incident = incident + 1
count = count + 1
End If
rsTotalfull.MoveNext
Loop
Else
rsSheet1.MoveFirst
incident = IIf(incident = 0, 1, rsRunning!INCIDENT_TOTALS -
rsRunning!incident + 1)
Do Until rsSheet1.EOF
If slocation = rsSheet1!location And saddress =
rsSheet1!address Then
samount = IIf(incident = 1, "0", IIf(incident = 2, "0",
IIf(incident = 3, "100", IIf(incident = 4, "100", IIf(incident = 5, "100",
"250")))))
sdate = rsSheet1!last_Date
sdatenew = sdate & " #" & incident & " $" & samount
sSql = "UPDATE Running INNER JOIN Sheet1 ON
(Running.ADDRESS = Sheet1.ADDRESS) AND (Running.LOCATION = Sheet1.LOCATION) "
& _
"SET Running.DATE_" & count & " = '" & sdatenew &
"'" & _
"WHERE Sheet1.[ADDRESS] = '" & saddress & "' AND
Sheet1.[LOCATION] = '" & slocation & "'"
DoCmd.RunSQL sSql
incident = incident + 1
count = count + 1
End If
rsSheet1.MoveNext
Loop
End If
rsRunning.MoveNext
Loop


Set rsnew = Nothing
Set rsRunning = Nothing
Set db = Nothing

ErrorHandler:

Dim strError As String
Dim errLoop As DAO.Error

' Enumerate Errors collection and display properties of
' each Error object.
For Each errLoop In Errors
With errLoop
strError = _
"Error #" & .Number & vbCr
strError = strError & _
" " & .Description & vbCr
strError = strError & _
" (Source: " & .Source & ")" & vbCr
strError = strError & _
"Press F1 to see topic " & .HelpContext & vbCr
strError = strError & _
" in the file " & .HelpFile & "."
End With
MsgBox strError
Next

'Resume Next

End Sub
Any help would be greatly appreciated.
Thanks, Neal
 
G

Guest

I would suggest

A: Comment out the ON Error Statement
B:m Single step through the process to see which queries are giving you the
results you expect..

I'll bet you find a limit on one of the queries that's supposed to be
loading into the rsRunning Load Query..



Neal said:
I have been working on this database for a while now to get it to work with
my info.I dont know enough about vba to know what Im looking for. It was
inherited from a previous admin, the problem that Im having is that when the
module finishes I dont get any results in the running table? I can not figure
it out, the rest of the table seem to fill in properly except on table shows
me to different months when there should only be one! This database is used
for keeping track of our clients alarms so we can bill accordingly.

Option Compare Database
Dim db As DAO.Database
Dim rsSheet1 As DAO.Recordset
Dim rsTotalfull As DAO.Recordset
Dim rsRunning As DAO.Recordset

Public Sub clovis()
Dim slocation As String, saddress As String, slocation2 As String, saddress2
As String
Dim sdate As String, sSql As String, sdatenew As String, samount As String
Dim incident As Integer
Dim count As Integer


On Error GoTo ErrorHandler
Set db = CurrentDb()

'Loads TEMP to parse and concatenate dates
DoCmd.OpenQuery "TEMP-Empty", acViewNormal, acEdit 'empty temp table
DoCmd.OpenQuery "TEMP-Load", acViewNormal, acEdit 'Loads temp table with
date parsed
DoCmd.OpenQuery "TEMP-Update", acViewNormal, acEdit 'concatenates date with
format

'Loads Lookup to scrub the location and address for matches
DoCmd.OpenQuery "Lookup-Load", acViewNormal, acEdit 'Loads lookup to validate
MsgBox ("Validate Locations in Lookup Table")

'Load all records through scrubbed Lookup table for correct locations and
addresses
DoCmd.OpenQuery "Sheet1-Empty", acViewNormal, acEdit 'empty sheet1 table
DoCmd.OpenQuery "Sheet1-Load", acViewNormal, acEdit 'Loads sheet1 table with
all data

'Load only 1 (last) record to the table for updating all dates
DoCmd.OpenQuery "Sheet2-Empty", acViewNormal, acEdit 'empty sheet2 table
DoCmd.OpenQuery "Sheet2-Append1record", acViewNormal, acEdit 'Loads sheet2
table with all data

'Load locations to the totals table
DoCmd.OpenQuery "TOTAL-LOAD", acViewNormal, acEdit 'Loads Total table with
all data

'Load the Incident table with totals after clear
DoCmd.OpenQuery "Incident-Empty", acViewNormal, acEdit 'empty Incident table
DoCmd.OpenQuery "Incident-Load", acViewNormal, acEdit 'Loads Incident table
with all data

MsgBox ("Change Query:'Total-Update(Incident)' to the correct month")

'Update incident to totals table with the amount of incidents per location
(all locations in now)
DoCmd.OpenQuery "Total-Update(Incident)", acViewNormal, acEdit 'Loads
Incident table with all data

'Load all records for history purposes
DoCmd.OpenQuery "Total_Full-Load", acViewNormal, acEdit 'Load all records

'Update totals for all incidents in Total_Full table
DoCmd.OpenQuery "Total-Update(Totals)", acViewNormal, acEdit 'Update all
records

'Sheet2 update total incidents from Totals table
DoCmd.OpenQuery "Sheet2-Update(Incidents)", acViewNormal, acEdit

'Load RUNNING table for adding amounts and incidents after date field
DoCmd.OpenQuery "RUNNING-Empty", acViewNormal, acEdit
DoCmd.OpenQuery "RUNNING-Load", acViewNormal, acEdit

'Puts the number of incidents and total amount due for each incident after
the date field.
Set rsSheet1 = CurrentDb.OpenRecordset("SELECT * from Sheet1 ORDER BY
address, location, last_date")
Set rsRunning = CurrentDb.OpenRecordset("SELECT * from RUNNING ORDER BY
address, location")
Set rsTotalfull = CurrentDb.OpenRecordset("SELECT * from Total_Full ORDER BY
address, location, date")


If Not rsRunning.EOF Then rsRunning.MoveFirst
Do Until rsRunning.EOF
slocation = rsRunning!location
saddress = rsRunning!address
sdate = rsRunning!Date
incident = rsRunning!INCIDENT_TOTALS - rsRunning!incident
count = 1
If incident < 4 And incident <> 0 Then
rsTotalfull.MoveFirst
incident = 1
Do Until rsTotalfull.EOF
If slocation = rsTotalfull!location And saddress =
rsTotalfull!address Then
samount = IIf(incident = 1, "0", IIf(incident = 2, "0",
IIf(incident = 3, "100", IIf(incident = 4, "100", IIf(incident = 5, "100",
"250")))))
sdate = rsTotalfull!Date
sdatenew = sdate & " #" & incident & " $" & samount
sSql = "UPDATE Running INNER JOIN TOTAL_FULL ON
(Running.ADDRESS = TOTAL_FULL.ADDRESS) AND (Running.LOCATION =
TOTAL_FULL.LOCATION) " & _
"SET Running.DATE_" & count & " = '" & sdatenew &
"'" & _
"WHERE Total_Full.[ADDRESS] = '" & saddress & "' AND
Total_Full.[LOCATION] = '" & slocation & "'"
DoCmd.RunSQL sSql
incident = incident + 1
count = count + 1
End If
rsTotalfull.MoveNext
Loop
Else
rsSheet1.MoveFirst
incident = IIf(incident = 0, 1, rsRunning!INCIDENT_TOTALS -
rsRunning!incident + 1)
Do Until rsSheet1.EOF
If slocation = rsSheet1!location And saddress =
rsSheet1!address Then
samount = IIf(incident = 1, "0", IIf(incident = 2, "0",
IIf(incident = 3, "100", IIf(incident = 4, "100", IIf(incident = 5, "100",
"250")))))
sdate = rsSheet1!last_Date
sdatenew = sdate & " #" & incident & " $" & samount
sSql = "UPDATE Running INNER JOIN Sheet1 ON
(Running.ADDRESS = Sheet1.ADDRESS) AND (Running.LOCATION = Sheet1.LOCATION) "
& _
"SET Running.DATE_" & count & " = '" & sdatenew &
"'" & _
"WHERE Sheet1.[ADDRESS] = '" & saddress & "' AND
Sheet1.[LOCATION] = '" & slocation & "'"
DoCmd.RunSQL sSql
incident = incident + 1
count = count + 1
End If
rsSheet1.MoveNext
Loop
End If
rsRunning.MoveNext
Loop


Set rsnew = Nothing
Set rsRunning = Nothing
Set db = Nothing

ErrorHandler:

Dim strError As String
Dim errLoop As DAO.Error

' Enumerate Errors collection and display properties of
' each Error object.
For Each errLoop In Errors
With errLoop
strError = _
"Error #" & .Number & vbCr
strError = strError & _
" " & .Description & vbCr
strError = strError & _
" (Source: " & .Source & ")" & vbCr
strError = strError & _
"Press F1 to see topic " & .HelpContext & vbCr
strError = strError & _
" in the file " & .HelpFile & "."
End With
MsgBox strError
Next

'Resume Next

End Sub
Any help would be greatly appreciated.
Thanks, Neal
 

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

Top