none
Assitance with CommitTran & RollBacks RRS feed

  • Question

  • Hi Folks -

    I'm very frustrated as I have not bee able to get a Function to finish cleanly. And I think it has to do where I am Beginning the trans and commiting the trans. There are also times when the Delete query doesn't work because it says its locked by a user session already.

    Here is my code - can anyone suggest better positioning of the Begin and commits? Should I be closing the db. variable after each usage in order to close the session on that table?

    Public Function Check_TA()
    On Error Resume Next
    
        Dim ws As Workspace
        Dim db As DAO.Database
        Dim tdf As DAO.TableDef
        Dim fld As DAO.Field
        Dim strSQL As String
        Dim strStep As String
        Dim strObject As String
        Dim strValue As Variant
        Dim outputFileName As String
        Dim strTest, strFunctName As String
    
        Set ws = DBEngine.Workspaces(0)
        Set db = ws.Databases(0)
        
        strFunctName = "Check_TA"
        strObject = "TA_TEMP"
        
        'Ensure TEMP Tables are deleted before processing
        Call DeleteTable(strObject & ",")
            
        On Error GoTo Proc_Err
        
        'Start a transaction to ensure all updates are run or rolled back
        ws.BeginTrans
                
        strStep = "Step 1 : Create temporary table [TA_TEMP]"
        strSQL = "" & _
                "SELECT DISTINCT * INTO [TA_TEMP]" & _
                "FROM ( SELECT" & _
                      "[Parent Node] AS [PFC_CODE]" & _
                    ", '' AS [PFC_ALIAS]" & _
                    ", '' AS [PFC_TA]" & _
                    ", [Name] AS [PFI_CODE]" & _
                    ", [Alias] AS [PFI_ALIAS]" & _
                    ", [PF_TherapeuticArea] AS [PFI_TA]" & _
                    ", [Portfolio Status] AS [PORTFOLIO_STATUS]" & _
                "FROM [LT-Project_Portfolio]" & _
                "WHERE [LT-Project_Portfolio].[Parent Node] LIKE 'PFC*'" & _
                    "AND [LT-Project_Portfolio].[Portfolio Status] NOT IN ('Terminated', 'Not Active')" & _
                ");"
        db.Execute strSQL, dbFailOnError
        strStep = ""
            
        strStep = "Step 2 : Update PFC Alias in table [TA_TEMP]"
        strSQL = "" & _
                "UPDATE [TA_TEMP]" & _
                    "INNER JOIN [Project_Portfolio]" & _
                    "ON [TA_TEMP].[PFC_CODE] = [Project_Portfolio].[Name]" & _
                        "SET" & _
                            "[TA_TEMP].[PFC_Alias] = [Project_Portfolio].[Alias]" & _
                            ", [TA_TEMP].[PFC_TA] = [Project_Portfolio].[PF_TherapeuticArea];"
        db.Execute strSQL, dbFailOnError
        strStep = ""
           
        'strStep = "Step 3 : Delete PFC Codes where [PF_TherapeuticArea] IS NOT BLANK"
        strSQL = "" & _
                " DELETE FROM [TA_TEMP]" & _
                " WHERE EXISTS (" & _
                    " SELECT 1" & _
                    " FROM [Project_Portfolio]" & _
                    " WHERE [TA_TEMP].[PFC_CODE] = [Project_Portfolio].[Name]" & _
                        " AND [Project_Portfolio].[PF_TherapeuticArea] IS NOT NULL" & _
                ");"
        db.Execute strSQL, dbFailOnError
        strSQL = ""
            
        Set rsObj = db.OpenRecordset(strObject)
        If rsObj.RecordCount > 0 Then
        
            outputFileName = "C:\Hyperion_Batch\Files\Exports\" & "Blank_TA_Values_" & Format(Date, "yyyyMMdd") & ".xls"
            
            strTest = Dir(outputFileName)
            If Not strTest = "" Then
                Kill (outputFileName)
            End If
            
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strObject, outputFileName, True
                    
        End If
                 
        'Delete TEMP tables
        Call DeleteTable(strObject & ",")
        
        ws.CommitTrans
            
    Proc_Exit:
    
        Set ws = Nothing
        Set db = Nothing
        Set rsObj = Nothing
        Set rs = Nothing
        
        Exit Function
    
    Proc_Err:
    
        strSubject = "WARNING: Function " & strFunctName & " Failed"
        strBody = strSubject & vbNewLine & vbNewLine & _
                  strStep & vbNewLine & vbNewLine & _
                  "VB Error: " & Err.Description
        strTo = "persson@gmail.com"
        Call Email_Utility(strSubject, strBody, strTo, "", "")
        
        ws.Rollback
        'MsgBox "Error updating: " & Err.Description & vbCrLf
        Resume Proc_Exit
        
    End Function

    Thank you for all your help!


    • Edited by cdtakacs1 Tuesday, March 19, 2019 11:53 AM
    Tuesday, March 19, 2019 11:52 AM

All replies

  • Well it looks like I need to commit the trans before I open up the record set. And then start a new trans within that next if statement.
    Tuesday, March 19, 2019 12:57 PM