Liz-
Thanks John for your quick response. I left early Friday and didn't log in all weekend.
Here's the code:
Private Sub cmdAccept_Click()
On Error GoTo err_cmdAccept
Dim strUser As String
strUser = GetLoginName()
Dim strWhat As String
strWhat = "SetECONumbers CALL"
If Not IsNull(Forms![RFC Input]![ECO]) And Forms![RFC Input]![ECO] <> "" Then
If DCount("[CRF #]", "ECB drawing action", "[CRF #]=" & Forms![RFC Input]![txtECR]) > 0 Then
Call SetECONumbers(Forms![RFC Input]![txtECR], Forms![RFC Input]![ECO]) ' added 6/2/2014 per change id 1926
End If
End If
' added 3/25/2013 per change id 1374
If IsNull(DLookup("UserName", "tblCM", "UserName = '" & strUser & "'")) Then
CurrentDb.Execute ("INSERT INTO AuditTable VALUES ('" & strUser & "', #" & Now() & _
"#, 'tried to close ECR#" & Forms![RFC Input]!txtECR & "', 'ECR DB')")
MsgBox ("UNAUTHORIZED USE")
Exit Sub
End If
Dim intECR As Long
intECR = Forms![RFC Input]!txtECR
Dim strsql As String
' Check for outstanding stop works on this ECR
If Not IsNull(Forms![RFC Input]![subformSWOs]![InitiatedDate]) And IsNull(Forms![RFC Input]![subformSWOs]![ClosedDate]) Then
MsgBox ("There is a stop work on this ECR -- cannot close.")
ElseIf CStr(Me.txtPasswd) = CStr(txtPasswd.Tag) Then
DoCmd.SetWarnings False
If Forms![RFC Input]![Cancelled] = False And Forms![RFC Input]![Rejected] = False Then
' added 6/24/2014 per change id 1944
SysCmd acSysCmdInitMeter, "Checking numbers to populate tracker... " & CStr(Now()), 0
strWhat = "selectECBToTrackerThisECRNoMatch - recordcount"
Dim intBefore As Integer
intBefore = Nz(DCount("ECR", "selECBToTrackerThisECRUnmatch"), 0) ' get how many should go over
DoCmd.DeleteObject acTable, "localToTrackerThisECR" ' write this data out to a local table
DoCmd.OpenQuery ("mkLocalToTrackerThisECR"), acViewNormal, acReadOnly
' end of the before check
SysCmd acSysCmdInitMeter, "Appending data to ECO Tracker... " & CStr(Now()), 0
strWhat = "appECBToTrackerThisECR"
DoCmd.OpenQuery ("appECBtoTrackerThisECR"), acViewNormal, acReadOnly
' SysCmd acSysCmdInitMeter, "Appending data to audit table... " & CStr(Now()), 0
' strWhat = "appECBToTrackerAuditThisECR"
' DoCmd.OpenQuery ("appECBtoTrackerAuditThisECR"), acViewNormal, acReadOnly
' beginning of after check of change 1944
Dim intAfter As Integer
intAfter = DCount("ECR", "PopulatedToTrackerThisECR")
If intBefore <> intAfter Then
DoCmd.OpenQuery ("ItemsNotPopulatedThisECR")
MsgBox ("All items that were to populate to the tracker did NOT populate to the tracker. Fix the problems if necessary and try again.")
CurrentDb.Execute ("INSERT INTO AuditTable VALUES ('" & strUser & "', #" & Now() & _
"#, ' had issue with populating items from ECR# " & Forms![RFC Input]!txtECR & "', 'ECR DB')")
Exit Sub
End If
' end of change id 1944
SysCmd acSysCmdInitMeter, "Appending data to Methods actions... " & CStr(Now()), 0
strWhat = "appECBtoActions"
DoCmd.OpenQuery ("appECBtoActions"), acViewNormal, acReadOnly ' 5/24/2012 noticed this didn't work all the time ??? wtf - did some times and not others
SysCmd acSysCmdInitMeter, "Appending data to PC Actions... " & CStr(Now()), 0
strWhat = "appECBtoPCActions"
DoCmd.OpenQuery ("appECBtoPCActions"), acViewNormal, acReadOnly
SysCmd acSysCmdInitMeter, "Appending data to CSA... " & CStr(Now()), 0
strWhat = "appCSAFromECB"
DoCmd.OpenQuery ("appCSAFromECB"), acViewNormal, acReadOnly
SysCmd acSysCmdInitMeter, "Updating ME assignments by program... " & CStr(Now()), 0
strWhat = "updMEByProg"
DoCmd.OpenQuery ("updMEByProg") ' necessary
strWhat = "updPCByProg"
SysCmd acSysCmdInitMeter, "Updating PC personnel by program... " & CStr(Now()), 0
DoCmd.OpenQuery ("updPCByProg") ' necessary
strWhat = "updProcByProg"
SysCmd acSysCmdInitMeter, "Updating Procurement personnel by program... " & CStr(Now()), 0
DoCmd.OpenQuery ("updProcByProg") ' necessary
strWhat = "updMEbyMon"
SysCmd acSysCmdInitMeter, "Updating ME personnel by monument... " & CStr(Now()), 0
DoCmd.OpenQuery ("updMEbyMon") ' necessary
strWhat = "updECIN"
SysCmd acSysCmdInitMeter, "Updating ECIN information... " & CStr(Now()), 0
DoCmd.OpenQuery ("updECIN") ' necessary
strWhat = "updNogalesMEs"
SysCmd acSysCmdInitMeter, "Updating Nogales personnel by program... " & CStr(Now()), 0
DoCmd.OpenQuery ("updNogalesMEs") ' necessary
' added 8/13/13 per change id 1549
SysCmd acSysCmdInitMeter, "Updating SB's to PDM... " & CStr(Now()), 0
DoCmd.OpenQuery ("updSBsToPDM")
PDMTracking: ' added 4/23/2013 per change id 1397
If IsPDM(Forms![RFC Input]![txtProgram]) Then
SysCmd acSysCmdInitMeter, "Updating Drawing to PDM... " & CStr(Now()), 0
strWhat = "updDrawingPDM"
DoCmd.OpenQuery ("updDrawingPDM")
SysCmd acSysCmdInitMeter, "Appending actions items to PDM... " & CStr(Now()), 0
strWhat = "appECBToPDMActions"
DoCmd.OpenQuery ("appECBToPDMActions")
End If
ProcurementSS: ' added 10/25/2013 per change id 1655
strWhat = "appSSToProc"
SysCmd acSysCmdInitMeter, "Appending shipset information for Procurement... " & CStr(Now()), 0
DoCmd.OpenQuery ("appSSToProc")
' added 11/8/2013 per change id 1690 - the eco release date is used for the first open ecr number this item is found on
strWhat = "set ecr num that says what ecrs have been open to null in eco release" ' important as of 2/20/2014
strsql = "UPDATE [ECB drawing action] SET [ECB drawing action].[ECO release date] = Null" & _
" WHERE [ECB drawing action].[ECO release date]='" & Forms![RFC Input]![txtECR] & "';"
SysCmd acSysCmdInitMeter, "Setting information to closed on 'other open ecrs'... " & CStr(Now()), 0
CurrentDb.Execute (strsql)
MsgBox ("ECO Tracker has now been populated." & vbCrLf)
End If
SetClosedDate:
Forms![RFC Input]![txtClosedDate] = Now() ' ************ FORM CLOSE FIELD *********
Dim intNumItems As Integer
intNumItems = DCount("[CRF #]", "[ECB drawing action]", "[CRF #] =" & Forms![RFC Input]![txtECR])
CurrentDb.Execute ("INSERT INTO AuditTable VALUES ('" & strUser & "', #" & Now() & _
"#, ' closed ECR# " & Forms![RFC Input]!txtECR & " With " & CStr(intNumItems) & " items." & "', 'ECR DB')")
SysCmd acSysCmdRemoveMeter
Else
MsgBox ("Incorrect password.")
txtPasswd = ""
End If
Forms![RFC Input].Refresh
Forms![RFC Input].SetFocus
Exit Sub
err_cmdAccept:
If Err.Number = 2448 Then
MsgBox ("The current ECR is locked by another user. ...showing the list of possbilities...")
DoCmd.OpenQuery ("qryLoggedIn")
ElseIf Err.Number = 3075 Then
MsgBox ("Possible data corruption problem. Have DBA do a compact/repair as necessary.")
Else
MsgBox ("There is a problem closing this ECR in " & strWhat & vbCrLf & Err.Description & " " & Err.Number)
End If
Resume Next
End Sub
The bit that isn't working 100 percent of the time is appECBtoTrackerThisECR and the sql for that is:
INSERT INTO Drawing ( Received, PMAYN, Description, [ECR #], Program, Monument, Drawing, Revision, ECO, SolutionItem, SolutionRev, ProblemAndSuggestion )
SELECT Date() AS Expr1, [RFC Input].PMAYN, ItemNumbers.ItemDesc, [RFC Input].[CRF #], [RFC Input].Program, [RFC Input].Monument, [ECB drawing action].[Drawing #], [ECB drawing action].Revision, Nz([EO/NIECO],"No ECO provided") AS Expr4, Nz([ECB drawing action]![SolutionItem],"none") AS Expr2, Nz([ECB drawing action]![SolutionRev],"none") AS Expr3, "Problem: " & Trim(Nz([RFC Input]![Problem],"")) & " Suggestions: " & Trim(Nz([RFC Input]![Suggestions],"")) & " WIP: " & Trim(Nz([RFC Input]![WIPNotes],"")) AS ProblemAndSuggestion
FROM ([RFC Input] LEFT JOIN [ECB drawing action] ON [RFC Input].[CRF #] = [ECB drawing action].[CRF #]) LEFT JOIN ItemNumbers ON [ECB drawing action].[Drawing #] = ItemNumbers.ItemNum
WHERE ((([ECB drawing action].[CRF #])=[Forms]![RFC Input]![txtECR]))
ORDER BY [ECB drawing action].[Drawing #];
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Friday, June 27, 2014 2:24 PM
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] append query inconsistent
Liz-
If you're doing the copy using an INSERT query, it should be an all or nothing proposition. It shouldn't drop some of the records - if there's any failure, it should do nothing.
What does your code look like?
John Viescas, Author
Microsoft Access 2010 Inside Out
Microsoft Access 2007 Inside Out
Microsoft Access 2003 Inside Out
Building Microsoft Access Applications
SQL Queries for Mere Mortals
(Paris, France)
On Jun 27, 2014, at 4:48 PM, Liz Ravenwood liz_ravenwood@beaerospace.com [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:
Pros, I have a process that runs an append query within VBA. The append runs in the front end and appends data from a linked table in one back end on a different server to a different back end (linked) but also on the same server. 98 percent of the time all the data moves across. About 2 percent of the time, some records don't move across. There isn't anything wrong with the records that don't append as I can insert them by hand (caveat coming).
So I wrote code that does something like this:
1. Check to see what items and how many should populate from one database to another (closing ecr's populates to an eco tracker)
2. Populate these items.
3. Count the items that I expected to populate to see if they did on the eco tracker.
4. If the numbers are the same, do nothing, but if not, then alert and insert info to an audit table.
Since I've discovered that data that didn't go over from over 500 records, my assistant and I are rerunning the process to repopulate the table. It works to repopulate, it seems, about 98 percent of the time. Yesterday we both had problems populating within seconds
of each other.
So, I've been working with corporate IT to see if that server had any errors logged and they didn't see any logged at the times in question. Sheila and I tried several times, got pulled on to other stuff, and an hour and a half later came back
and then they populated just fine.
No change to the code. No change to compact/repair any back end data. I don't see any processes that I have that would cause this to happen.
Any ideas?
Respectfully,
Liz Ravenwood
Programmer / Analyst
B/E Aerospace | Super First Class Environments
1851 S Pantano Road | Tucson, Arizona 85710
Office +1.520.239.4808 |
Passion to Innovate. Power to Deliver
This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.
This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.
Posted by: John Viescas <johnv@msn.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (4) |
Tidak ada komentar:
Posting Komentar