Solved Function as Boolean (1 Viewer)

ClaraBarton

Registered User.
Local time
Today, 01:51
Joined
Oct 14, 2019
Messages
119
I think I don't understand Boolean functions. You helped me here last night so here I am again. My function does what it's supposed to do but it doesn't return anything. It creates a query -- qryOut filled with a recordset. Then I want to export it. I need the boolean part to error out when there are too many records or no fields or anything else that might go wrong. I thought if it was successful it would return yes but it never does. It always returns fail when I know it didn't fail when going back to the calling sub. What is wrong here?

Code:
Public Function GetSql() As Boolean
On Error GoTo errHandler

Dim i As Integer
Dim sFields As String
Dim sFilter As String
Dim rsTmp As DAO.Recordset
Dim db As Database
Dim sSource As String
Dim lngNumRecords As Long


 For i = 0 To lstExportFields.ListCount - 1
        If Trim$(sFields) <> "" Then
            sFields = sFields & ","
        End If
        sFields = sFields & "[" & lstExportFields.ItemData(i) & "]"
 Next
        If sFields = "" Then
            MsgBox "Please select some fields to export first"
            Exit Function
        End If
    
    If IsTableOrQuery(txtSource) Then
        txtSource = "[" & txtSource & "]"
    Else
        txtSource = "(" & Replace$(txtSource, ";", "") & ")"
    End If
          sSource = "SELECT " & sFields & " FROM " & Me!txtSource
    If Nz(txtFilter) = "" Then
        i = MsgBox("Are you sure you want to export all records?", _
            vbQuestion + vbOKCancel, "Export All Records?")
        If i = vbCancel Then
            Exit Function
        End If
    Else
        sFilter = " WHERE " & RemoveFormRef(txtFilter)
        sSource = sSource & sFilter
    End If
 
    Set db = CurrentDb
    Set rsTmp = db.OpenRecordset( _
            Name:=sSource, _
            Type:=dbOpenSnapshot, _
            Options:=dbReadOnly)
  
             lngNumRecords = rsTmp.RecordCount
    rsTmp.Close
Set rsTmp = Nothing

    If lngNumRecords = 0 Then
        MsgBox "no Matching Records found", vbOKOnly, "No Records Found"
        DoCmd.Close acForm, "frmExport"
    Else
        If IsNull(DLookup("name", "msysobjects", "name='qryOut'")) Then
            CurrentDb.CreateQueryDef "qryOut", sSource
        Else
            Dim qd As QueryDef
            Set qd = CurrentDb.QueryDefs("qryOut")
            qd.SQL = sSource
            Set qd = Nothing
        End If
    End If
Set db = Nothing
Exit_Function:
    Exit Function
    
errHandler:
    MsgBox "ERROR # " & Err.Number & vbCrLf & _
        Err.Description, vbCritical + vbOKOnly, _
        "Error in Export Function"
        Resume Exit_Function
            
End Function


Private Sub cmdExport_Click()
On Error GoTo Err_cmdExport

Dim strPath As String
Dim qryOut As QueryDef
If GetSql() Then
        
        strPath = CurrentProject.Path & _
            "\" & Me.FileName & Me.Extension
            
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
                    qryOut, strPath, True
                    
        MsgBox "Done!"
        DoCmd.Close acForm, "frmExport"
Else
    MsgBox "Something here isn't right. " _
        & "Either exit or try again.", vbOKOnly, "Failed Export"

End If
Exit_cmdExport:
    Exit Sub
    
Err_cmdExport:
    MsgBox "ERROR # " & Err.Number & vbCrLf & _
        Err.Description, vbCritical + vbOKOnly, _
        "Error in Export Function"
        Resume Exit_cmdExport
            
End Sub
 

theDBguy

I’m here to help
Staff member
Local time
Today, 01:51
Joined
Oct 29, 2018
Messages
14,191
Hi. For a function to return something, you'll have to assign it a value. Here's what I would usually have.
Code:
Public Function TrueOrFalse() As Boolean
On Error GoTo errHandler

Dim boolResult As Boolean

boolResult = True

'do some stuff here

errExit:
    TrueOrFalse = boolResult
    Exit Function

errHandler:
    boolResult = False
    'error handler here
    Resume errExit

End Function
Hope that helps...
 

arnelgp

error reading drive A:
Local time
Today, 17:51
Joined
May 7, 2009
Messages
11,578
Code:
Public Function GetSql() As Boolean
On Error GoTo errHandler

Dim i As Integer
Dim sFields As String
Dim sFilter As String
Dim rsTmp As DAO.Recordset
Dim db As Database
Dim sSource As String
Dim lngNumRecords As Long

GetSql = False

For i = 0 To lstExportFields.ListCount - 1
        If Trim$(sFields) <> "" Then
            sFields = sFields & ","
        End If
        sFields = sFields & "[" & lstExportFields.ItemData(i) & "]"
Next
If sFields = "" Then
        MsgBox "Please select some fields to export first"
        Exit Function
End If
    
If IsTableOrQuery(txtSource) Then
        txtSource = "[" & txtSource & "]"
Else
        txtSource = "(" & Replace$(txtSource, ";", "") & ")"
End If
sSource = "SELECT " & sFields & " FROM " & Me!txtSource
If Nz(txtFilter) = "" Then
        i = MsgBox("Are you sure you want to export all records?", _
            vbQuestion + vbOKCancel, "Export All Records?")
        If i = vbCancel Then
            Exit Function
        End If
    Else
        sFilter = " WHERE " & RemoveFormRef(txtFilter)
        sSource = sSource & sFilter
    End If
 
    Set db = CurrentDb
    Set rsTmp = db.OpenRecordset( _
            Name:=sSource, _
            Type:=dbOpenSnapshot, _
            Options:=dbReadOnly)
 
             lngNumRecords = rsTmp.RecordCount
    rsTmp.Close
Set rsTmp = Nothing

    If lngNumRecords = 0 Then
        MsgBox "no Matching Records found", vbOKOnly, "No Records Found"
        DoCmd.Close acForm, "frmExport"
    Else
        GetSql = True
        If IsNull(DLookup("name", "msysobjects", "name='qryOut'")) Then
            CurrentDb.CreateQueryDef "qryOut", sSource
        Else
            Dim qd As QueryDef
            Set qd = CurrentDb.QueryDefs("qryOut")
            qd.SQL = sSource
            Set qd = Nothing
        End If
    End If
Set db = Nothing
Exit_Function:
    Exit Function
    
errHandler:
    MsgBox "ERROR # " & Err.Number & vbCrLf & _
        Err.Description, vbCritical + vbOKOnly, _
        "Error in Export Function"
        GetSql = False
        Resume Exit_Function
            
End Function
 

ClaraBarton

Registered User.
Local time
Today, 01:51
Joined
Oct 14, 2019
Messages
119
Feeling stupid here... I put BoolResult = False and GetSql = BoolResult at the beginning of the function and then at the end when everything is finished with no fails and we're going back to the calling sub I put BoolResult = True. So shouldn't the calling form get that true result?
 

ClaraBarton

Registered User.
Local time
Today, 01:51
Joined
Oct 14, 2019
Messages
119
Oh, I'm sorry... I didn't see arnelpg's reply. I'm trying that.
 

arnelgp

error reading drive A:
Local time
Today, 17:51
Joined
May 7, 2009
Messages
11,578
Initially set it to False, since it is in early stage of the code and we might "exit the function early".
see the last If..Else...End If, I am setting it to True (when everything is ok at this point).
but if error occurs, i again reset it to False (see errHandler code).
 

theDBguy

I’m here to help
Staff member
Local time
Today, 01:51
Joined
Oct 29, 2018
Messages
14,191
Feeling stupid here... I put BoolResult = False and GetSql = BoolResult at the beginning of the function and then at the end when everything is finished with no fails and we're going back to the calling sub I put BoolResult = True. So shouldn't the calling form get that true result?
Yes, sounds like it should, but I guess it doesn't matter now. Glad to hear you got it sorted out.

Good luck with your project.
 

Users who are viewing this thread

Top Bottom