Solved

Need Code Optimization - MS Access - VBA

Posted on 2011-09-04
21
329 Views
Last Modified: 2012-05-12
I have a form and its one of the most complex forms that I have created.  There is a lot going on however and its sluggish on certain items such as clearing record locks.  I would ask you professionals to look at the code behind the one button giving me the most slowdown.  Please provide any insight to better optimizing this code.
Private Sub btn_find_Click()
On Error GoTo Err_btn_find_Click

        '--- Set form variables
        
         Dim ctl As Control
         Dim rs As Recordset
         Dim strRecLock As String
         Dim sParm As Variant
         Dim Lockuser As String
        
        '--- Set form parameters and set focus on ReqDate control
        
         sParm = Me.txt_LoadID
         strLockUser = Environ("username")
         txt_reqDate.SetFocus
         
        '--- Enable message to user "ESC to cancel search" and apply Green button color for search
        
         lbl_cancelsrch.Visible = True
         Me.BTN_FIND.BackColor = RGB(153, 204, 0)
         
        '--- See what state FIND Button is in FIND or SEARCH.  Check to see if form has data or not
        '--- If form has data, prompt user to confirm clearing of form
        
    If BTN_FIND.Caption = "FIND" Then
        If Me.isdirty = True Then
            If MsgBox("Form has been changed.  Do you want to clear the form?", vbYesNo, "WARNING") = vbYes Then
                
        '--- Clear all form controls upon confirmation
        
                For Each ctl In Me.Controls
                    Select Case ctl.ControlType
                        Case acComboBox, acListBox, acOptionGroup, acTextBox, acCheckBox
                            ctl.Value = ctl.DefaultValue
                            End Select
                            
        '--- Ensure form is back to normal state, no labels showing.  Change FIND button to SEARCH state
        '--- enable LoadID control for search criteria and set focus here
        
                            LBL_CANCELLED.Visible = False
                            lbl_ibshipper.Visible = False
                            btn_Details.Visible = False
                            txt_LoadID.Enabled = True
                            BTN_FIND.Caption = "SEARCH"
                            txt_LoadID.SetFocus
                    Next
        
        '--- Go to RemoveLock to remove any record locks applied
        
                        GoTo RemoveLock
                        
            Else
                Exit Sub
            End If
        
        '--- If form is not dirty with record then clear form without user confirmation
        
        Else
        
        '--- Clear all form controls
        
                    For Each ctl In Me.Controls
                        Select Case ctl.ControlType
                            Case acComboBox, acListBox, acOptionGroup, acTextBox, acCheckBox
                                ctl.Value = ctl.DefaultValue
                                End Select
                                
        '--- Ensure form is back to normal state, no labels showing.  Change FIND button to SEARCH state
        '--- enable LoadID control for search criteria and set focus here
        
                                Me.LBL_CANCELLED.Visible = False
                                Me.lbl_ibshipper.Visible = False
                                Me.btn_Details.Visible = False
                                Me.txt_LoadID.Enabled = True
                                Me.BTN_FIND.Caption = "SEARCH"
                                txt_LoadID.SetFocus
                        Next

        '--- Go to RemoveLock to remove any record locks applied
        
                            GoTo RemoveLock
                            
                        
                    
RemoveLock:
        
        '--- Remove Lock from current record
                    
                    strLockUser = Environ("username")
                    
        '--- Check to see if any locks exist for current user in current form
        
                    If DCount("[LD_RECLOCK]", "TBL_LOAD_HED", "[LD_RECLOCK_USER] = '" & strLockUser & "'") >= 1 Then
                       
        '--- If locks are present clear locks
        
                         strLock = "select * from TBL_LOAD_HED where LD_RECLOCK_USER ='" & strLockUser & "'"
                         Set rs = CurrentDb.OpenRecordset(strLock, dbOpenDynaset, dbSeeChanges)
                           
                            Do
                            rs.Edit
                                rs.Fields("LD_RECLOCK") = ""
                                rs.Fields("LD_RECLOCK_USER") = ""
                            rs.Update
                            rs.MoveNext
                            Loop Until rs.EOF
                            rs.Close
                            Set rs = Nothing
                        
                    Else
        
        '--- if no locks present then go to Delete Temp
        
                        GoTo DeleteTemp
                    End If
                            
        '--- Remove any records in DET TEMP Table for next record
DeleteTemp:
                            DoCmd.SetWarnings False
                            strSQLdel = "Delete * from TBL_LOAD_DET_TEMP"
                            DoCmd.RunSQL strSQLdel
                            DoCmd.SetWarnings True
                            
            Exit Sub
        End If
        
        '--- If FIND Button is in SEARCH state then
        
    ElseIf Me.BTN_FIND.Caption = "SEARCH" Then
    
        '--- See if search criteria has been entered.  If no valid criteria then error message to user
        
        If IsNull(txt_LoadID) = True Or txt_LoadID = "" Then
            MsgBox "Nothing to search.  Enter valid Load Number", vbOKOnly, "ERROR"
            txt_LoadID.SetFocus
            Exit Sub
        Else
        
        '--- check to see if record is locked before ruturning record to user.  If locked LOCK notification
        '--- to user, exit sub, set focus to LoadID control
            
             If DLookup("[LD_RECLOCK]", "TBL_LOAD_HED", "[LD_NUM] = " & sParm) = "LOCKED" Then
                Lockuser = DLookup("LD_RECLOCK_USER", "TBL_LOAD_HED", "[LD_NUM] =" & sParm)
                MsgBox "User " & UCase(Lockuser) & " has record locked. Try again later"
                Me.txt_LoadID.SetFocus
                Exit Sub
                
            Else
        
        '--- If valid criteria and no locks found then return FIND button to FIND state and original color
        '--- set form to dirty
            
                Me.BTN_FIND.Caption = "FIND"
                BTN_FIND.BackColor = RGB(47, 54, 153)
                Me.isdirty = True
                
        '--- Run query to populate form with record
        
                strSQL = "Select * from TBL_LOAD_HED where LD_NUM =" & sParm
                Set rs = CurrentDb.OpenRecordset(strSQL)
                
                    rs.MoveFirst
                        txt_carrier = rs.Fields("LD_CARRIER")
                        txt_reqDate = rs.Fields("LD_REQ_DATE")
                        txt_shipDate = rs.Fields("LD_SHIP_DATE")
                        cbo_custID = rs.Fields("LD_CUST_ID")
                        txt_CustName = rs.Fields("LD_CUST_NAME")
                        txt_CustCity = rs.Fields("LD_CUST_CITY")
                        txt_CustState = rs.Fields("LD_CUST_STATE")
                        txt_CustZip = rs.Fields("LD_CUST_ZIP")
                        txt_delCarrier = rs.Fields("LD_DEL_CARRIER")
                        txt_apptDate = rs.Fields("LD_APPT_DATE")
                        txt_apptTime = rs.Fields("LD_APPT_TIME")
                        cbo_shipToID = rs.Fields("LD_SHIPTO_ID")
                        txt_Instr = rs.Fields("LD_INSTRUCTIONS")
                        txt_delDate = rs.Fields("LD_DEL_DATE")
                        txt_bolNum = rs.Fields("LD_SHIP_NUM")
                        txt_bolLoc = rs.Fields("LD_SHIP_LOC")
                        cbo_inbShipperID = rs.Fields("LD_INB_SHIPPER")
                        txt_locName = rs.Fields("LD_LOC")
                        cbo_loc = rs.Fields("LD_LOC")
                        txt_createdBy = rs.Fields("LD_CREATED_BY")
                        txt_createdOn = rs.Fields("LD_CREATED_DATE")
                        txt_modifiedBy = rs.Fields("LD_MODIFIED_BY")
                        txt_modifiedOn = rs.Fields("LD_MODIFIED_DATE")
                    rs.Close
                    Set rs = Nothing
                    
        '--- Populate form controls with data that is not in recordset found in LD_HED table
                    
                        txt_custPhone = DLookup("[CUST_PHONE]", "TBL_CUST_HED", "[CUST_ID] = " & [Forms]![frm_build_load]![cbo_custID])
                        txt_shipToName = DLookup("CUST_NAME", "TBL_CUST_HED", "[CUST_ID] = " & [Forms]![frm_build_load]![cbo_custID])
                        txt_shipToCity = DLookup("DET_CITY", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")
                        txt_shipToState = DLookup("DET_STATE", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")
                        txt_shipToZip = DLookup("DET_ZIP", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")
                        txt_shipToPh = DLookup("DET_PHONE", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")
            
        '--- Append LOAD DET records to TEMP table and requery DET subform
                    
                    DoCmd.SetWarnings False
                    DoCmd.OpenQuery "QRY_LOAD_DET_FIND", acViewNormal
                    DoCmd.SetWarnings True
                    
                    Forms![frm_build_load].[FRM_LOAD_DET].Requery
                    
        '--- Hide message "ESC to cancel search"
                    
                    Me.lbl_cancelsrch.Visible = False
                    
        '--- Apply record lock to selected record
                    
                                strLock = "select * from TBL_LOAD_HED where LD_NUM =" & sParm
                                Set rs = CurrentDb.OpenRecordset(strLock, dbOpenDynaset, dbSeeChanges)
                                
                                rs.Edit
                                    rs.Fields("LD_RECLOCK") = "LOCKED"
                                    rs.Fields("LD_RECLOCK_USER") = Environ("USERNAME")
                                rs.Update
                                rs.Close
                                Set rs = Nothing
                          
            End If
        End If
    End If
    

Exit_btn_find_Click:
    Exit Sub

Err_btn_find_Click:
    MsgBox Err.Description
    Resume Exit_btn_find_Click
    
End Sub

Open in new window

0
Comment
Question by:pskeens
  • 11
  • 4
  • 3
  • +1
21 Comments
 
LVL 84
ID: 36483363
First: I have a difficult time following code that uses GoTo. IMO, the only time you should use GoTo syntax is for error handling. Otherwise, use Select Case, If-then or other logic flow syntax to control where you code goes.

Why are you looping through your controls and setting them to Default values? If this is a bound form, and you're just moving  to a different record, then Access will "clear" the form for you. If it's not bound, then just set the form to an empty string, or to 0, or whatever make sense. With complex forms moving through the control collection can take some time, so often you're better off explicitly clearing controls:

Me.Textbox1=""
Me.Combo2= ""

Move this out of your loop:

                            LBL_CANCELLED.Visible = False
                            lbl_ibshipper.Visible = False
                            btn_Details.Visible = False
                            txt_LoadID.Enabled = True
                            BTN_FIND.Caption = "SEARCH"
                            txt_LoadID.SetFocus

There's no need to call this for each control

replace ths block:

                            DoCmd.SetWarnings False
                            strSQLdel = "Delete * from TBL_LOAD_DET_TEMP"
                            DoCmd.RunSQL strSQLdel
                            DoCmd.SetWarnings True


With this line:

currentdb.execute "DELETE * FROM tbl_load_det_temp"

Use a Recordset instead of a string of DLookups:

txt_custPhone = DLookup("[CUST_PHONE]", "TBL_CUST_HED", "[CUST_ID] = " & [Forms]![frm_build_load]![cbo_custID])
                        txt_shipToName = DLookup("CUST_NAME", "TBL_CUST_HED", "[CUST_ID] = " & [Forms]![frm_build_load]![cbo_custID])
                        txt_shipToCity = DLookup("DET_CITY", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")
                        txt_shipToState = DLookup("DET_STATE", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")
                        txt_shipToZip = DLookup("DET_ZIP", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")
                        txt_shipToPh = DLookup("DET_PHONE", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")

should be written as

Dim rst = Currentdb.OpenRecordset("SELECT * FROM tbl_cust_hed WHERE cust_id=" Y forms("frm_build_load").cboCustID)
txt_shiptoname = rst("Cust_Name")
Same for the filter on ShipToID

0
 
LVL 10

Expert Comment

by:plummet
ID: 36483543
Also, in the  section following "'--- If locks are present clear locks" you will save some time by executing a single update such as

strLock = "Update TBL_LOAD_HED set LD_RECLOCK='', LD_RECLOCK_USER= ''where LD_RECLOCK_USER ='" & strLockUser & "'"
currentdb.execute strLock

Open in new window


There are some more examples where you could do this too.

In the section titled "'--- Run query to populate form with record" you could extract all the data you need in one hit by adding some joins to the other relevant tables, eg:

strSQL = "Select t1.*, t2.CUST_PHONE, t2.CUST_NAME, t3.DET_CITY, t3.DET_STATE, t3.DET_ZIP, t3.DET_PHONE  from TBL_LOAD_HED t1
left join TBL_CUST_HED t2 on t1.LD_CUST_ID = t2.CUST_ID
left join TBL_CUST_DET t3 on t1.LD_SHIPTO_ID = t3.DET_ID
where t1.LD_NUM =" & sParm

Open in new window

THis would save having to run all those Dlookups.

There are probably more savings to be made, I will try to have a closer look.
0
 
LVL 2

Author Comment

by:pskeens
ID: 36483893
Thanks, will get to work on changing the code recommended.  To answer your question this is an unbound form.  This is the reason for a lot of the extra code.  Almost all forms in my application are unbound just to have the control desired with searching, editing, and creating new records.

I was always told that using Goto is more effecient when having long code that you do not need to to through.  In this case there is a whole section of code that gets jumped over by the "if" statement being true.  In the code below when the IF statement is true then it skips over the italicized code:


    If BTN_FIND.Caption = "FIND" Then
        If Me.isdirty = True Then
            If MsgBox("Form has been changed.  Do you want to clear the form?", vbYesNo, "WARNING") = vbYes Then
               
        '--- Clear all form controls upon confirmation
       
                For Each ctl In Me.Controls
                    Select Case ctl.ControlType
                        Case acComboBox, acListBox, acOptionGroup, acTextBox, acCheckBox
                            ctl.Value = ctl.DefaultValue
                            End Select
                           
        '--- Ensure form is back to normal state, no labels showing.  Change FIND button to SEARCH state
        '--- enable LoadID control for search criteria and set focus here
       
                            LBL_CANCELLED.Visible = False
                            lbl_ibshipper.Visible = False
                            btn_Details.Visible = False
                            txt_LoadID.Enabled = True
                            BTN_FIND.Caption = "SEARCH"
                            txt_LoadID.SetFocus
                    Next
       
        '--- Go to RemoveLock to remove any record locks applied
       
>>>>                        GoTo RemoveLock
                       
           Else
                Exit Sub
            End If
       
        '--- If form is not dirty with record then clear form without user confirmation
       
        Else
       
        '--- Clear all form controls
       
                    For Each ctl In Me.Controls
                        Select Case ctl.ControlType
                            Case acComboBox, acListBox, acOptionGroup, acTextBox, acCheckBox
                                ctl.Value = ctl.DefaultValue
                                End Select
                               
        '--- Ensure form is back to normal state, no labels showing.  Change FIND button to SEARCH state
        '--- enable LoadID control for search criteria and set focus here
       
                                Me.LBL_CANCELLED.Visible = False
                                Me.lbl_ibshipper.Visible = False
                                Me.btn_Details.Visible = False
                                Me.txt_LoadID.Enabled = True
                                Me.BTN_FIND.Caption = "SEARCH"
                                txt_LoadID.SetFocus
                        Next

        '--- Go to RemoveLock to remove any record locks applied
       
                            GoTo RemoveLock

                           
                       
                   
>>>> RemoveLock:
0
 
LVL 10

Expert Comment

by:plummet
ID: 36483955
A golden rule of programming is "Never use goto (other than in on error goto statements)". It's not more efficient and can lead to terrible trouble debugging.

I'd remove the gotos if it was me. But I don't think it's affecting the performance of your form.
0
 
LVL 57

Assisted Solution

by:Jim Dettman (Microsoft MVP/ EE MVE)
Jim Dettman (Microsoft MVP/ EE MVE) earned 250 total points
ID: 36484046
<<Thanks, will get to work on changing the code recommended.  To answer your question this is an unbound form.  This is the reason for a lot of the extra code.  Almost all forms in my application are unbound just to have the control desired with searching, editing, and creating new records.>>

  First I have to ask, why are you bothering to use Access?  If your going to go through all that work (in using un-bound forms), then another product would be a better choice.  


On the code:
 
A. "strLockUser = Environ("username")"

  Using the USERNAME envrionment variable is a bad idea.  It can be spoofed quite easily.  Instead, use the Windows API call GetUserName():

Private Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserNameA Lib "advapi32.dll" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function WhoAmI(bReturnUserName As Boolean) As String

        ' Function returns either user name or computer name

        Dim strName As String * 255

10      If bReturnUserName = True Then
20        GetUserNameA strName, Len(strName)
30      Else
40        GetComputerNameA strName, Len(strName)
50      End If

60      WhoAmI = left$(strName, InStr(strName, vbNullChar) - 1)

End Function


B. Your calling it multiple times even though you've already place it in the variable strLockUser.   I would setup a global variable to hold the value and fetch it once.  Do something like this in a standard module:

Private strUserName as string

Function GetUserName() as string

   If strUserName ="" then  strUserName = WhoAmi(True)
  GetUserName = strUserName

End Function

  but I would not even bother.  The call to WhoAmI() is fast enough on it's own.


C. On this:


       '--- Check to see if any locks exist for current user in current form
       
                    If DCount("[LD_RECLOCK]", "TBL_LOAD_HED", "[LD_RECLOCK_USER] = '" & strLockUser & "'") >= 1 Then
                       
        '--- If locks are present clear locks
       
                         strLock = "select * from TBL_LOAD_HED where LD_RECLOCK_USER ='" & strLockUser & "'"
                         Set rs = CurrentDb.OpenRecordset(strLock, dbOpenDynaset, dbSeeChanges)
                           
                            Do
                            rs.Edit
                                rs.Fields("LD_RECLOCK") = ""
                                rs.Fields("LD_RECLOCK_USER") = ""
                            rs.Update
                            rs.MoveNext


  Bad idea.  Simply do:

   strLock = "DELETE * FROM TBL_LOAD_HED where LD_RECLOCK_USER ='" & strLockUser & "'"
   CurrentDB().Execute strLock, dbFailOnError

D.  I would not put all that locking logic in your form routines, but generalize it for the app.  See the following article for ideas:

http://www.experts-exchange.com/Microsoft/Development/MS_Access/A_5328-Resource-locking-in-your-applications.html

E. These:

                        txt_custPhone = DLookup("[CUST_PHONE]", "TBL_CUST_HED", "[CUST_ID] = " & [Forms]![frm_build_load]![cbo_custID])
                        txt_shipToName = DLookup("CUST_NAME", "TBL_CUST_HED", "[CUST_ID] = " & [Forms]![frm_build_load]![cbo_custID])
                        txt_shipToCity = DLookup("DET_CITY", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")
                        txt_shipToState = DLookup("DET_STATE", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")
                        txt_shipToZip = DLookup("DET_ZIP", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")
                        txt_shipToPh = DLookup("DET_PHONE", "TBL_CUST_DET", "[DET_ID] = '" & [Forms]![frm_build_load]![cbo_shipToID] & "'")


  are a killer.  Your executing a SQL statement for each of those.  Really inefficent as LSM already pointed out.   If you every have to do more then one Dlookup against the same recordsource, you are far better off to open a recordset, find the record you need, and have all the fields at your disposal.

F.  On this:

        '--- check to see if record is locked before ruturning record to user.  If locked LOCK notification
        '--- to user, exit sub, set focus to LoadID control
           
             If DLookup("[LD_RECLOCK]", "TBL_LOAD_HED", "[LD_NUM] = " & sParm) = "LOCKED" Then
                Lockuser = DLookup("LD_RECLOCK_USER", "TBL_LOAD_HED", "[LD_NUM] =" & sParm)
                MsgBox "User " & UCase(Lockuser) & " has record locked. Try again later"
                Me.txt_LoadID.SetFocus
                Exit Sub
 
  Same thing.  And a couple other things on your locking, which you'll see in the article:

1. You have no error handling  - depending on the number of users, your bound to get collisions when trying to place and clear locks.  You must account for this.

2. Your only handling exclusive locking, which you are going to find very restrictive, unless your point is to use this for editing only (i.e. what if someone runs a report against the table while someone else is editing; is that OK?, etc).

HTH,
Jim.
0
 
LVL 2

Author Comment

by:pskeens
ID: 36484133
Thanks Jim.  To answer  a couple of your questions:

1. You have no error handling  - depending on the number of users, your bound to get collisions when trying to place and clear locks.  You must account for this.

The record lock happens at form level.  Nobody else can call the record if "LOCKED" is present in current record within the table.  They get a message telling them the record is locked by "username", try again later.  No person can have the same record in a form at the same time, so therefore it cannot be edited by more than one person.

2. Your only handling exclusive locking, which you are going to find very restrictive, unless your point is to use this for editing only (i.e. what if someone runs a report against the table while someone else is editing; is that OK?, etc).

Thats correct.  Reports do not look for this lock, so it will not prevent users from running any reports with locked records.
0
 
LVL 57
ID: 36484186
<<The record lock happens at form level.  Nobody else can call the record if "LOCKED" is present in current record within the table.  They get a message telling them the record is locked by "username", try again later.  No person can have the same record in a form at the same time, so therefore it cannot be edited by more than one person.>>

  Understood, but you missed the point.  All the locks for each user are being placed against one table (TBL_LOAD_HED).  In fact I didn't mention it, but this code will fail logically:

        '--- Apply record lock to selected record
                   
                                strLock = "select * from TBL_LOAD_HED where LD_NUM =" & sParm
                                Set rs = CurrentDb.OpenRecordset(strLock, dbOpenDynaset, dbSeeChanges)
                               
                                rs.Edit
                                    rs.Fields("LD_RECLOCK") = "LOCKED"
                                    rs.Fields("LD_RECLOCK_USER") = Environ("USERNAME")
                                rs.Update
                                rs.Close
                                Set rs = Nothing


  as you don't bother to lock the table while your placing the lock.  If two users go after the same record at the same instant, they both may be granted a lock.   You need to be locking TBL_LOAD_HED while you place the lock.

Also, a comment on this:

strLock = "select * from TBL_LOAD_HED where LD_NUM =" & sParm

 Never return more fields then you need.  And second, this is the actual data table; you don't want your lock flag in there.  Why?

1. You need to lock the table while placing the lock.

2. If the power goes out/shoftware process is interuppted, you'll need to go through every record in the table to clear all the locks.  Again read the article I posted the link to.   A single lock table for all table locks is a much better approach.

Jim.
0
 
LVL 2

Author Comment

by:pskeens
ID: 36484791
Jim, thanks again for your assistance.  I am looking at changing the Lock routine to the article you posted.  However I have a question.  I am trying to modify it the the first instance without the flexible options that are not needed.  I have the table set up as below.  I am trying to create the functions but I am getting lost in removing the extra code.  Any Insights to what I should/could remove?

I have changed the name of the table for my standard naming convention.

TBL_REC_LOCK
0
 
LVL 2

Author Comment

by:pskeens
ID: 36484902
PLUMMET:

The query string with Joins is a tremendous idea, not sure why I never thought of it.........  

Anyhow, I am getting this error when executing it.

                    strCustInfo = "Select t1.*, t2.CUST_PHONE, t2.CUST_NAME, t3.DET_CITY, t3.DET_STATE, t3.DET_ZIP, t3.DET_PHONE" & _
                        "from TBL_LOAD_HED t1" & _
                        "left join TBL_CUST_HED t2 on t1.LD_CUST_ID = t2.CUST_ID" & _
                        "left join TBL_CUST_DET t3 on t1.LD_SHIPTO_ID = t3.DET_ID" & _
                        "where t1.LD_NUM = " & sParm
                    Set rst = CurrentDb.OpenRecordset(strCustInfo, dbOpenSnapshot) '<<<<<<<<<<<< BREAK HAPPENS HERE
strCustInfo-Error.PNG
0
 
LVL 10

Expert Comment

by:plummet
ID: 36485090
It looks like you need to add some spaces - in front of "from", "Left join" (two of these!) and "where"

Otherwise it looks ok I reckon. This will be better:

 
strCustInfo = "Select t1.*, t2.CUST_PHONE, t2.CUST_NAME, t3.DET_CITY, t3.DET_STATE, t3.DET_ZIP, t3.DET_PHONE " & _
                        "from TBL_LOAD_HED t1" & _
                        " left join TBL_CUST_HED t2 on t1.LD_CUST_ID = t2.CUST_ID" & _
                        " left join TBL_CUST_DET t3 on t1.LD_SHIPTO_ID = t3.DET_ID" & _
                        " where t1.LD_NUM = " & sParm

Open in new window


Cheers,
John
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 57
ID: 36485141
<<Any Insights to what I should/could remove?>>

  There is not much to remove outside of the lock level flag (Resource Tag is = LOC_TABLE_NAME and SubTag = LOC_REC_ID), but why would you want to?  Just drop the code into a module and call it like this:

 Dim varRet as Variant

 varReturn = PlaceResourceLock("TBL_LOAD_HED", sParam, 3,  True)
 If varReturn = True then
    ' Ok to edit the record
 Else
    ' Could not get a lock - message displayed by routine or an error occured - in either case, we do nothing here.
 End If

and to clear:

 varReturn = ClearResourceLock("TBL_LOAD_HED", sParam, WhoAmI(True), WhoAmI(False))

  And your done!

Jim.

0
 
LVL 2

Author Comment

by:pskeens
ID: 36485699
John, Query works great in SQL but cannot get it to work in access.  I have messed with it for a long time and give up!  lol.

I have tried changing it to Access SQL but still get an error.  thoughts?
0
 
LVL 2

Author Comment

by:pskeens
ID: 36486033
Wow I'm so stupid.  Nevermind on that one John!  I created a view in SQL and using that to populate the form.  Wow, some of us are really slow! haha.
0
 
LVL 2

Author Comment

by:pskeens
ID: 36486068
Jim,

I have created the table:

tblResourceLock
LockID – Autonumber – Primary Key
ResourceTag – Text – Index 1A
ResourceSubTag – Text - Index 1B
UserID – Long – User ID that placed lock
DTPlaced – Date/Time
LockLevel – Integer


and created the two Functions for PlaceResourceLock and ClearResourceLock.

Now question is how do I call this in the form?  

Thanks
0
 
LVL 2

Author Comment

by:pskeens
ID: 36486540
Here is the latest code.  I have removed all the Dlookup strings.  Changed the Locking to another method. (Similar to Jim's, but still cannot get his to work)

Does this look better?  Anything else I should look at changing?


Private Sub btn_find_Click()
On Error GoTo Err_btn_find_Click

        '--- Set form variables
            
            Dim Tblname As String
            Dim LockUser As String
            Dim LockDate As String
            Dim strUserName As String
            Dim ctl As Control
            Dim rs As Recordset
            Dim strRecLock As String
            Dim sParm As Variant
            
         '--- Set form parameters and set focus on ReqDate control
         
            Tblname = "TBL_LOAD_HED"
            LockUser = foSUserName()
            LockDate = Now()
            sParm = Me.txt_LoadID
            txt_reqDate.SetFocus

         
        '--- Enable message to user "ESC to cancel search" and apply Green button color for search
        
         lbl_cancelsrch.Visible = True
         Me.BTN_FIND.BackColor = RGB(153, 204, 0)
         
        '--- See what state FIND Button is in FIND or SEARCH.  Check to see if form has data or not
        '--- If form has data, prompt user to confirm clearing of form
        
    If BTN_FIND.Caption = "FIND" Then
        If Me.isdirty = True Then
            If MsgBox("Form has been changed.  Do you want to clear the form?", vbYesNo, "WARNING") = vbYes Then
            
                 If DCount("*", "TBL_REC_LOCK", "[LOC_USER_ID] ='" & LockUser & "' And [LOC_TABLE_NAME] = '" & Tblname & "'") >= 1 Then
        
                 DoCmd.SetWarnings False
                 strSQL = "DELETE from [TBL_REC_LOCK] where [LOC_USER_ID] = '" & LockUser & "' and [LOC_TABLE_NAME] = '" & Tblname & "'"
                 DoCmd.RunSQL (strSQL)
                 DoCmd.SetWarnings True
                 
                 End If
            Else
            Exit Sub
            End If

        '--- Clear all form controls upon confirmation
        
                For Each ctl In Me.Controls
                    Select Case ctl.ControlType
                        Case acComboBox, acListBox, acOptionGroup, acTextBox, acCheckBox
                            ctl.Value = ctl.DefaultValue
                            End Select
                            
        '--- Ensure form is back to normal state, no labels showing.  Change FIND button to SEARCH state
        '--- enable LoadID control for search criteria and set focus here
        
                            LBL_CANCELLED.Visible = False
                            lbl_ibshipper.Visible = False
                            btn_Details.Visible = False
                            txt_LoadID.Enabled = True
                            BTN_FIND.Caption = "SEARCH"
                            txt_LoadID.SetFocus
                    Next
        Else
        
        '--- If form is not dirty with record then clear form without user confirmation
        
            If DCount("*", "TBL_REC_LOCK", "[LOC_USER_ID] ='" & LockUser & "' And [LOC_TABLE_NAME] = '" & Tblname & "'") >= 1 Then
   
                DoCmd.SetWarnings False
                strSQL = "DELETE from [TBL_REC_LOCK] where [LOC_USER_ID] = '" & LockUser & "' and [LOC_TABLE_NAME] = '" & Tblname & "'"
                DoCmd.RunSQL (strSQL)
                DoCmd.SetWarnings True
            End If
            
        '--- Clear all form controls
        
                    For Each ctl In Me.Controls
                        Select Case ctl.ControlType
                            Case acComboBox, acListBox, acOptionGroup, acTextBox, acCheckBox
                                ctl.Value = ctl.DefaultValue
                                End Select
                                
                                
        '--- Ensure form is back to normal state, no labels showing.  Change FIND button to SEARCH state
        '--- enable LoadID control for search criteria and set focus here
        
                                Me.LBL_CANCELLED.Visible = False
                                Me.lbl_ibshipper.Visible = False
                                Me.btn_Details.Visible = False
                                Me.txt_LoadID.Enabled = True
                                Me.BTN_FIND.Caption = "SEARCH"
                                txt_LoadID.SetFocus
                        Next
    
        '--- Remove any records in DET TEMP Table for next record

                            DoCmd.SetWarnings False
                            strSQLdel = "Delete * from TBL_LOAD_DET_TEMP"
                            DoCmd.RunSQL strSQLdel
                            DoCmd.SetWarnings True
                            
                Exit Sub
            End If
        
        '--- If FIND Button is in SEARCH state then
        
    ElseIf Me.BTN_FIND.Caption = "SEARCH" Then
    
        Dim LockRecID As String
        LockRecID = txt_LoadID
        
        '--- See if search criteria has been entered.  If no valid criteria then error message to user
        
        If IsNull(txt_LoadID) = True Or txt_LoadID = "" Then
            MsgBox "Nothing to search.  Enter valid Load Number", vbOKOnly, "ERROR"
            txt_LoadID.SetFocus
            Exit Sub
        ElseIf DCount("*", "TBL_LOAD_HED", "[LD_NUM]=" & sParm) = 0 Then
            MsgBox "No records matching search criteria. Enter a valid Load Number", vbOKOnly, "ERROR"
            txt_LoadID.SetFocus
            Exit Sub
        End If
        
        '--- check to see if record is locked before ruturning record to user.  If locked LOCK notification
        '--- to user, exit sub, set focus to LoadID control
                

        If DCount("*", "TBL_REC_LOCK", "[LOC_REC_ID] ='" & LockRecID & "' And [LOC_TABLE_NAME] = '" & Tblname & "'") >= 1 Then
           MsgBox "Another User has this record locked.  Try again later", vbOKOnly, "RECORD LOCKED"
           txt_LoadID.SetFocus
           Exit Sub
        End If
        
    
        '--- If valid criteria and no locks found then return FIND button to FIND state and original color
        '--- set form to dirty
            
                Me.BTN_FIND.Caption = "FIND"
                BTN_FIND.BackColor = RGB(47, 54, 153)
                Me.isdirty = True
                
        '--- Run query to populate form with record
        
                strSQL = "Select * from VW_LOAD_HED where LD_NUM =" & sParm
                Set rs = CurrentDb.OpenRecordset(strSQL)
                
                    rs.MoveFirst
                        txt_carrier = rs.Fields("LD_CARRIER")
                        txt_reqDate = rs.Fields("LD_REQ_DATE")
                        txt_shipDate = rs.Fields("LD_SHIP_DATE")
                        cbo_custID = rs.Fields("LD_CUST_ID")
                        txt_CustName = rs.Fields("LD_CUST_NAME")
                        txt_CustCity = rs.Fields("LD_CUST_CITY")
                        txt_CustState = rs.Fields("LD_CUST_STATE")
                        txt_CustZip = rs.Fields("LD_CUST_ZIP")
                        txt_custPhone = rs.Fields("CUST_PHONE")
                        txt_delCarrier = rs.Fields("LD_DEL_CARRIER")
                        txt_apptDate = rs.Fields("LD_APPT_DATE")
                        txt_apptTime = rs.Fields("LD_APPT_TIME")
                        cbo_shipToID = rs.Fields("LD_SHIPTO_ID")
                        txt_shipToName = rs.Fields("DET_NAME")
                        txt_shipToCity = rs.Fields("DET_CITY")
                        txt_shipToState = rs.Fields("DET_STATE")
                        txt_shipToZip = rs.Fields("DET_ZIP")
                        txt_shipToPh = rs.Fields("DET_PHONE")
                        txt_Instr = rs.Fields("LD_INSTRUCTIONS")
                        txt_delDate = rs.Fields("LD_DEL_DATE")
                        txt_bolNum = rs.Fields("LD_SHIP_NUM")
                        txt_bolLoc = rs.Fields("LD_SHIP_LOC")
                        cbo_inbShipperID = rs.Fields("LD_INB_SHIPPER")
                        txt_locName = rs.Fields("LD_LOC")
                        cbo_loc = rs.Fields("LD_LOC")
                        txt_createdBy = rs.Fields("LD_CREATED_BY")
                        txt_createdOn = rs.Fields("LD_CREATED_DATE")
                        txt_modifiedBy = rs.Fields("LD_MODIFIED_BY")
                        txt_modifiedOn = rs.Fields("LD_MODIFIED_DATE")
                    rs.Close
                    Set rs = Nothing
                    
        '--- Append LOAD DET records to TEMP table and requery DET subform
                    
                    DoCmd.SetWarnings False
                    DoCmd.OpenQuery "QRY_LOAD_DET_FIND", acViewNormal
                    DoCmd.SetWarnings True
                    
                    Forms![frm_build_load].[FRM_LOAD_DET].Requery
                    
        '--- Hide message "ESC to cancel search"
                    
                    Me.lbl_cancelsrch.Visible = False
                    
        '--- Apply record lock to selected record
                    
                DoCmd.SetWarnings False
                    strSQL = "INSERT INTO TBL_REC_LOCK ([LOC_TABLE_NAME],[LOC_REC_ID],[LOC_USER_ID],[LOC_DT_PLACED])" & _
                        "VALUES ('" & Tblname & "', '" & LockRecID & "', '" & LockUser & "', '" & LockDate & "')"
                
                DoCmd.RunSQL (strSQL)
                DoCmd.SetWarnings True
                          
    End If
        
Exit_btn_find_Click:
    Exit Sub

Err_btn_find_Click:
    MsgBox Err.Description
    Resume Exit_btn_find_Click
    
End Sub

Open in new window

0
 
LVL 10

Accepted Solution

by:
plummet earned 250 total points
ID: 36486853
In the "'--- Clear all form controls upon confirmation" section you have a loop for all controls. You have one Select case in there, and then you are setting some properties for the same controls every time the loop runs, which is obviously a waste of time as this should just be done once.

You've got the same problem in the "'--- Clear all form controls" section - move the 6 lines setting properties and doing the SetFocus to after the for/next loop.

That should improve performance noticeably.

It looks like you solved your problem with the SQL left joins, etc, with VW_LOAD_HED? I hope so!

Another thing you can do is change where you have "DoCmd.RunSQL (strSQL) " to "CurrentDB.Execute strSQL" - then you don't have to worry about setwarnings, and it might be a bit quicker.

I hope the performance increases after all your changes, please let us know.

Cheers
John
0
 
LVL 2

Author Comment

by:pskeens
ID: 36489464
Changing  "DoCmd.RunSQL (strSQL) " to "CurrentDB.Execute strSQL" did the trick for performance!  

Thanks guys for your assistance on this!  You have been a tremendous help!  

I am splitting the points to both since you both gave valuable solutions on this optimization!

0
 
LVL 2

Author Closing Comment

by:pskeens
ID: 36489500
The answers to this question have been a tremendous help!  Thanks to everyone who helped out.  Wish I had more points to allocate!
0
 
LVL 84
ID: 36492916
I'm surprised that you didn't also select my first comment, especially since you did select comment #36486853, which said exactly the same thing (i.e. move the code our of your loops, and use Currentdb.Execute instead of DoCmd.RunSQL).

0
 
LVL 2

Author Comment

by:pskeens
ID: 36492930
Sorry LSM!!!  Its very hard to award points in this system with so many great people helping!  I did overlook you this time.  

Sorry AGAIN!
0
 
LVL 84
ID: 36501624
No troubles, just wanted to make the point that the comment suggested had been offered previously. It's really up to the Experts to insure they do not duplicate posts. As the question thread gets longer, however, that becomes a bit more difficult of course, but taking the time to review previous comments is just part of the deal (at least in my opinion).

Scott

0

Featured Post

Free Gift Card with Acronis Backup Purchase!

Backup any data in any location: local and remote systems, physical and virtual servers, private and public clouds, Macs and PCs, tablets and mobile devices, & more! For limited time only, buy any Acronis backup products and get a FREE Amazon/Best Buy gift card worth up to $200!

Join & Write a Comment

In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now