函数returns空结果

Question

我在调用该函数时收到空的 msgBox。看看下面的代码

Public Function Custom(ByVal TableName As String, _
    ByVal EmployeeCode As String, ByVal FieldName As String, ByVal DataToCheck As String, _
    Optional ByVal CodeFieldName As String = Empty, Optional ByVal CodeFieldValue As String = Empty) As Boolean

Dim lstrSQL1 As String
Dim lrsTemp1 As ADODB.Recordset

lstrSQL1 = " Select  " & FieldName & "  from  " & TableName & " Where ID_CARD_NO =" & DataToCheck & ""
'MsgBox (lstrSQL1)

If Len(Trim$(CodeFieldName)) <> 0 And Len(Trim$(CodeFieldValue)) <> 0 Then
   lstrSQL1 = lstrSQL1 & " AND " & CodeFieldName & " <> '" & CodeFieldValue & "'"


End If

Set lrsTemp1 = cObjDBConn.ExecuteSQL(lstrSQL1)

If lrsTemp1 Is Nothing Then
    Custom = False
ElseIf Not (lrsTemp1.BOF And lrsTemp1.EOF) Then
    Custom = True
ElseIf lrsTemp1.RecordCount = 0 Then
    Custom = False
Else
    Custom = False
End If

If lrsTemp1.State = adStateOpen Then lrsTemp1.Close
Set lrsTemp1 = Nothing

Exit Function

ErrorHandle:

    Custom = False


End Function

调用代码在这里：

If gobjValidation.Custom(fstrTableName, gEmployeeCode, "EMPLOYEE_CODE", _
                Trim$(TxtIDcardNo.text)) = True Then
                MsgBox (gEmployeeCode)
                Call MessageBox("This ID Number is already existing for another  employee. Cannot enter duplicate number!Using By Employee Code:" & gEmployerCode & " ", OKOnly, Information, DefaultButton1, Me.Caption)
                sstInformationTab.Tab = 0

Answer 1

正如@Arvo 所说，您需要将您的 EmployeeCode 变量设为 ByRef，然后在您的函数 Custom() 中为其赋值

Public Function Custom(ByVal TableName As String, _
    **ByRef EmployeeCode As String**, ByVal FieldName As String, ByVal DataToCheck As String, _
    Optional ByVal CodeFieldName As String = Empty, Optional ByVal CodeFieldValue As String = Empty) As Boolean

Dim lstrSQL1 As String
Dim lrsTemp1 As ADODB.Recordset

    lstrSQL1 = " Select  " & FieldName & "  from  " & TableName & " Where ID_CARD_NO =" & DataToCheck & ""
    'MsgBox (lstrSQL1)

    If Len(Trim$(CodeFieldName)) <> 0 And Len(Trim$(CodeFieldValue)) <> 0 Then
       lstrSQL1 = lstrSQL1 & " AND " & CodeFieldName & " <> '" & CodeFieldValue & "'"
    End If

    Set lrsTemp1 = cObjDBConn.ExecuteSQL(lstrSQL1)

    If lrsTemp1 Is Nothing Then
        Custom = False
    ElseIf Not (lrsTemp1.BOF And lrsTemp1.EOF) Then
        Custom = True
        **lrsTemp1.MoveFirst**
        **EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")**
    ElseIf lrsTemp1.RecordCount = 0 Then
        Custom = False
    Else
        Custom = False
    End If

    If lrsTemp1.State = adStateOpen Then lrsTemp1.Close
    Set lrsTemp1 = Nothing

Exit Function

ErrorHandle:
    Custom = False
End Function

双星号只是为了突出我对您的原始代码所做的更改。

函数returns空结果

Function returns empty result

vb6