db.Close affecting calling script - why?

[SIMMS7400]

Hi Folks -



I have a function where a set the database and workspace into there respective variables to leverages throughout the procedure. I also have a call to another Function which I also set a "db" variable. In the called script when I am done processing, I always close the recordset but I want to close the db as well.

However, when I close the db and set to nothing, i bombs when I return back to the main function. Why? I thought these objects were set within each function and would have no bearing on one or the other.

Here is my main function:

Public Function Process_Activity_Updates()

'::-- Error Handler --::'
On Error GoTo Proc_Err
        
    '::-- Initialize --::'
    If strActivate_Flag = 0 Then Call Activate_Modules
    
    Dim db As DAO.Database
    Dim ws As DAO.Workspace
    
    Dim sRS As DAO.Recordset, tRS As DAO.Recordset, tRSMV As DAO.Recordset
    Dim fld As DAO.Field2
    
    Dim i As Integer
    
    Dim sTable As String, tTable As String, strMask As String, strNameSub As String
    Dim tgtStr As String, srcStr As String, tmpStr As String, tFlds As String, sFlds As String, vCriteria As String
    Dim tFld() As String, sFld() As String, actionVal() As String, actionVals As String, ReqVals As String, ReqVal() As String
    
    Dim strFunctName As String, strStartTime As Date, strEndTime As Date, strTimeDiff As String
    Dim strStep As String, strSubject As String, strBody As String, strTo As String, strProcError As String
    
    Set ws = DBEngine.Workspaces(0)
    Set db = ws.Databases(0)
       
    strFunctName = "Process_Activity_Updates": strStartTime = Format(Now, "mm/dd/yyyy hh:mm:ss")
    strMask = "PFP*"
    sTable = "MDM_Project_Portfolio_Reference"
    tTable = "rdActivity"
    strNameSub = "Name"

    tFlds = "Parent_Node,Alias,Phase,Time_Tracking,Research_DDU,Project_Type,PrePostCS,Status,Direct_Indirect,Model_Flag_CMC,Model_Flag_PRD,Model_Flag_DEV"
    sFlds = "Parent Node,Alias,Phase (Nominal),Time_Tracking,PRD_DDU,ProjectType,PrePostCS,PFP Status,Direct Flag,ASC_CMC_MODEL_T,ASC_PRD_MODEL_T,ASC_DEV_MODEL_T"

    actionVals = ",TREX-WorkingVersion,Portfolio,,,,"
    actionVal = Split(actionVals, ",")
    
    ReqVals = ",,,,,,,"
    ReqVal = Split(ReqVals, ",")
    
    tFld = Split(tFlds, ",")
    sFld = Split(sFlds, ",")
    
    Set sRS = db.OpenRecordset("SELECT * FROM [" & sTable & "] WHERE [Name] LIKE """ & strMask & """", dbOpenDynaset)
    Set tRS = db.OpenRecordset("SELECT * FROM [" & tTable & "] WHERE [RequestStatus] = ""Updated""", dbOpenDynaset)
    
    Call Clear_ActionScript_Table

    If tRS.RecordCount > 0 _
        And Mid(tRS.Fields("Parent_Node").value, 1, 4) = "PFR-" Or _
        Mid(tRS.Fields("Parent_Node").value, 1, 4) = "PFI-" Or _
        Mid(tRS.Fields("Parent_Node").value, 1, 4) = "PFG-" Then
            
        'start a transaction to ensure all updates are run or rolled back
        ws.BeginTrans: strTFlag = 1
            
        Do Until tRS.EOF
        
            '::-- Determine Requestor --::'
            strModifiedID = tRS![Modified By]
            Set uRS = db.OpenRecordset("SELECT [Work Email] FROM [UserInfo] WHERE [ID] LIKE """ & strModifiedID & """", dbOpenDynaset)
            If uRS.RecordCount > 0 Then
                strModEmail = uRS![Work Email]: strModName = Split(strModEmail, "@")(0): strModName = Replace(strModName, ".", " ")
            End If
                                  
            ReqVal(0) = Split(tRS.Fields("Modified").value, " ")(0)
            ReqVal(1) = Nz(tRS.Fields("Workflow_Notify_Name").value, strModName)
            ReqVal(2) = tRS.Fields(strNameSub).value
            ReqVal(3) = tRS.Fields("Alias").value
            ReqVal(7) = Nz(tRS.Fields("Workflow_Notify_Email").value, strModEmail)
                        
            srcStr = "": tgtStr = ""
        
            vCriteria = "Name = '" & tRS.Fields(strNameSub).value & "'"
            sRS.MoveFirst
            sRS.FindFirst vCriteria
    
            For i = 0 To UBound(tFld)
            
                actionVal(0) = "ChangeProp"
            
                'Set fld to check .IsComplex property
                Set fld = tRS(tFld(i))
                
                If Nz(fld.value) <> "" Then
                
                    strStep = "Update Data Element Attributes" & vbNewLine & vbNewLine & _
                              "Data Element - " & Nz(tRS.Fields(strNameSub).value, "") & vbNewLine & _
                              "Source Field - " & Nz(sFld(i), "") & vbNewLine & _
                              "Source Value - " & Nz(sRS.Fields(sFld(i)).value, "") & vbNewLine & _
                              "Target Field - " & Nz(tFld(i), "") & vbNewLine & _
                              "Target Value - " & Nz(tRS.Fields(tFld(i)).value, "")
                   
                    'Ignore MVF Attributes
                    If Not fld.IsComplex Then
                          If Nz(tRS.Fields(tFld(i)).value, "foo") <> Nz(sRS.Fields(sFld(i)).value, "foo") Then
                               If sFld(i) = "Parent Node" Then
                                   actionVal(0) = "Move"
                                   actionVal(3) = tRS.Fields(strNameSub).value
                                   actionVal(4) = Nz(tRS.Fields(tFld(i)).value, "")
                                   actionVal(5) = ""
                                   Call Add_ActionScript(actionVal)
                                   
                                    ReqVal(4) = tFld(i)
                                    ReqVal(5) = Nz(sRS.Fields(sFld(i)).value, "No Value")
                                    ReqVal(6) = Nz(tRS.Fields(tFld(i)).value, "No Value")
                                    Call Add_Request(ReqVal)
                               
                               Else
                                   actionVal(0) = "Changeprop"
                                   actionVal(3) = tRS.Fields(strNameSub).value
                                   actionVal(4) = sFld(i)
                                   actionVal(5) = Nz(tRS.Fields(tFld(i)).value, "")
                                   Call Add_ActionScript(actionVal)
                                   
                                    ReqVal(4) = tFld(i)
                                    ReqVal(5) = Nz(sRS.Fields(sFld(i)).value, "No Value")
                                    ReqVal(6) = Nz(tRS.Fields(tFld(i)).value, "No Value")
                                    Call Add_Request(ReqVal)
                                    
                              End If
                                                          
                        End If
    
                    Else

                        'Set the multichoice record set
                        Set tRSMV = tRS(tFld(i)).value
                            
                        'set string variable with all the selected values seperated by commas
                        tgtStr = ""
                        Do Until tRSMV.EOF
                            tRSMV.MoveFirst
                                Do Until tRSMV.EOF
                                    tgtStr = tgtStr + tRSMV!value.value + ","
                                    tRSMV.MoveNext
                                Loop
                        Loop
                        If Not tgtStr = "" Then
                            tgtStr = Mid(tgtStr, 1, Len(tgtStr) - 1)
                        End If
             
                        srcStr = Nz(sRS.Fields(sFld(i)).value, "")
                        If srcStr <> tgtStr Then
                            actionVal(3) = tRS.Fields(strNameSub).value
                            actionVal(4) = sFld(i)
                            actionVal(5) = tgtStr
                            Call Add_ActionScript(actionVal)
                            
                            ReqVal(4) = tFld(i)
                            ReqVal(5) = Nz(sRS.Fields(sFld(i)).value, "No Value")
                            ReqVal(6) = Nz(tRS.Fields(tFld(i)).value, "No Value")
                            Call Add_Request(ReqVal)
                            
                        End If
                    End If
                End If
                
            Next
                            
            If tRS.Fields("RequestStatus").value <> "Published" Then
                tRS.Edit
                tRS.Fields("RequestStatus").value = "Published"
                tRS.Update
            End If
            
            tRS.MoveNext
                   
        Loop
        
        'commit all changes
        ws.CommitTrans: strTFlag = 0
        
        'Create Action Script
        Call Export_ActionScript
        
        MsgBox "Attention : " & tTable & " Change Requests have been processed" & vbNewLine & vbNewLine & _
               "Function  : " & strFunctName & vbNewLine & vbNewLine & _
               "Action Script Path : " & str_Manual_ActionScript_Bin

    Else
        MsgBox "Attention : " & tTable & " contains no Change Requests" & vbNewLine & vbNewLine & _
               "Function  : " & strFunctName
    End If
    
Proc_Exit:

    '::-- Update Table with Procedure Information --::'
    strEndTime = Format(Now, "mm/dd/yyyy hh:mm:ss")
    strTimeDiff = strEndTime - strStartTime
    Call ADD_RUN_TIMES( _
                        strFunctName, _
                        strStartTime, _
                        strEndTime, _
                        Hour(strTimeDiff) & " hours " & Minute(strTimeDiff) & " minutes " & Second(strTimeDiff) & " seconds", _
                        Switch(strProcError = "", "Success", Not (strProcError = ""), "Failed"), _
                        strProcError _
                       )
    
    If Not sRS Is Nothing Then sRS.Close
    If Not tRS Is Nothing Then tRS.Close
    If Not tRSMV Is Nothing Then tRSMV.Close
    If Not ws Is Nothing Then ws.Close
    If Not db Is Nothing Then db.Close
    
    Set sRS = Nothing
    Set tRS = Nothing
    Set tRSMV = Nothing
    Set ws = Nothing
    Set db = Nothing
    
    Exit Function

Proc_Err:

    '::-- Rollback Transaction --::'
    If strTFlag = 1 Then ws.Rollback
    
    '::-- Capture VB Error --::'
    strProcError = Err.Description
    
    strSubject = "WARNING : Function '" & strFunctName & "' Failed " & strEnvType
    strBody = Switch(strStep = "", "", Not (strStep = ""), strStep & vbNewLine & vbNewLine) & _
              "VB Error : " & strProcError & vbNewLine & vbNewLine & _
              "Profile : " & CurrentUser() & vbNewLine & _
              "VB Module : " & Application.VBE.ActiveCodePane.CodeModule.Name
    strTo = strMDMSupportEmail
    Call MDM_Routines.Email_Utility(strSubject, strBody, strTo, "", "")
    
    Resume Proc_Exit
    
End Function

And here is the function I call from the Function above:

Public Function Add_ActionScript(vParam() As String)

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("tblActionScript")
    
    With rs
        .AddNew
        !Action = vParam(0)
        !Param1 = vParam(1)
        !Param2 = vParam(2)
        !Param3 = vParam(3)
        !Param4 = vParam(4)
        !Param5 = vParam(5)
        !Param6 = vParam(6)
        .Update
    End With
        
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    
End Function

But when I add db.Close and Set db = Nothing in the called Function, it bombs when I return to the main. Why is this?

[Micron]

I think what you want to do is research "ms access variable scope"
All the variables in that code (which I only skimmed over) are procedure level - all are out of scope when the procedure finishes. I'll continue looking to see if I have any suggestions on the code itself.

EDIT - only a minor point. I wouldn't declare one type and use a name prefix of another type (e.g. dteDate As Date rather than strDate As Date)

Upon further looking, reading up on scope might be warranted and maybe not. However, IMO you're closing the current db, not some other db or workspace (not that you created a second work space but that could be another option) so when you get back to the calling procedure I'd say your ws is gone because your db is not quite closed but certainly out of scope. I stopped using workspaces long ago when the CurrentDb option was introduced so I may be a bit rusty on them. You might want to just Set db to Nothing and don't close it. Another route could be to forego the db & rs entirely and just use an update sql or query.

[SIMMS7400]

I think what you want to do is research "ms access variable scope"
All the variables in that code (which I only skimmed over) are procedure level - all are out of scope when the procedure finishes. I'll continue looking to see if I have any suggestions on the code itself.

EDIT - only a minor point. I wouldn't declare one type and use a name prefix of another type (e.g. dteDate As Date rather than strDate As Date)

Upon further looking, reading up on scope might be warranted and maybe not. However, IMO you're closing the current db, not some other db or workspace (not that you created a second work space but that could be another option) so when you get back to the calling procedure I'd say your ws is gone because your db is not quite closed but certainly out of scope. I stopped using workspaces long ago when the CurrentDb option was introduced so I may be a bit rusty on them. You might want to just Set db to Nothing and don't close it. Another route could be to forego the db & rs entirely and just use an update sql or query.

Thank you for the tips, Micron! You are right about strDate, I will go ahead and update accordingly. Also, let me try out setting db to nothing first and will report back.

Additionally, you mentioned you don't use Workspaces anymore. How come? Can you provide a little more detail on CurrentDb then? Are you able to rollback using CurrentDb? Whats the benefit? Thanks, Micron!

[Micron]

To clarify, I was using DBEngine.Workspaces(0).Databases(0) but since I rarely needed to use transactions, I dropped it in favour of CurrentDb.

The former is a pointer to a db and may require refreshing a collection when the db is modified, which may be a performance hit. However, it is supposed to be faster than CurrentDb but in terms of being noticeable it probably hasn't mattered for 20 years - unless perhaps if one is doing very intensive operations. That and what experts claim is that the number of records in a db has little effect on speed of one method over the other as it is the number of objects that are important. I've also read that using Databases(0) is not advisable in a multi user environment but I suppose that depends on whether or not you're dropping/adding tables and the like (something else I try to avoid). Moot point but some of your code can be eliminated simply by using DBEngine(0)(0) rather than creating several variables and Set statements. As for transactions, IIRC you use the Workspace object - DBEngine.Workspaces(0) thus don't need a reference to Databases(0)

Maybe see also
https://docs.microsoft.com/en-us/off...tion.currentdb

https://docs.microsoft.com/en-us/off...-dao-recordset

[isladogs]

Following on from Micron's comments, I ran some speed tests a couple of years ago to check whether DBEngine(0)(0) really was faster than CurrentDb.
I had read a claim by an Access MVP that it was anything up to 5000 times faster
My tests indicated that was nonsense and that in fact CurrentDb is SLIGHTLY faster.

For more info, see http://www.mendipdatasystems.co.uk/s...s-2/4594428908

[ssanfu]

The Rule I learned was:

If you Create it, Destroy it,
If you Open it, Close it.


So, you Create dB, but you don't Open it.

    Dim db As DAO.Database
    Set db = ws.Databases(0)              '<< create db

    If Not db Is Nothing Then db.Close    '<<< You created it, but never OPENED it, so you shouldn't close db!!
    
    Set db = Nothing                      '<< destroy db

You Create sRS AND then you Open it

    Dim sRS As DAO.Recordset              '<< create sRs

    Set sRS = db.OpenRecordset("SELECT * FROM [" & sTable & "] WHERE [Name] LIKE """ & strMask & """", dbOpenDynaset)   'You OPENED sRs

    If Not sRS Is Nothing Then sRS.Close  '<< close sRs
    
    Set sRS = Nothing                     '<< destroy sRs

Also, instead of the If() statements, I use

  'code
  'more code

    'Clean Up
    On Error Resume Next
    sRS.Close        'Recordset
    tRS.Close        'Recordset
    tRSMV.Close    'Recordset

End Function