• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 149
  • Last Modified:

Can not exit function created in Word VBA.

I'm debugging step by step a simple situation. When a recordset has no records; I want to exit the function. I watch every step of the way, when the exit function command runs it just sits there and does not return to the line in the proceedure that originally called the function. How do I go out debugging this situation?
0
swendell
Asked:
swendell
  • 4
  • 4
1 Solution
 
bruintjeCommented:
Hello swendell,

could you post a bit of relevant code?

you can always use

  Do Until rst.EOF
      ' do some processing here
      For Each fld In rst.Fields
         Debug.Print fld.Value & ";";
      Next
      Debug.Print
      rst.MoveNext
   Loop

   ' Close the recordset
   rst.Close

which will automatically prevent the loop if there are no records

hope this helps a bit
bruintje
0
 
swendellAuthor Commented:
The complete LinktoXYZ function is below which is called from another function or SUB. It will not return to the calling function or sub when there are no records in the record set. It does not lockup in the record set loop; it just HANGS where you see I commented below. Not sure how to debug this:

On Error GoTo LinktoError ' Enable error trapping to help debugging
Debug.Print "-----  START -----"
 
Dim objConn As ADODB.Connection
Set objConn = New ADODB.Connection
'Debug.Print "ADO Object created"
 
Dim sConnect As String   ' Declaring the Connection
'Debug.Print "String varable created to hold ADO connection string"
 
sConnect = "Provider=sqloledb;Data Source=rtsql; Initial Catalog=XYZ; User Id=MrMacro; Password=x;"
'Debug.Print "Connection string assigned to varable"
 
objConn.Open sConnect    ' Opening the Connection
 
If objConn.State = adStateOpen Then Debug.Print "ADO Connection is OPEN to Server: rtsql  Database: XYZ"
'Debug.Print "Default Database:" & objConn.DefaultDatabase
 
' Open a Recordset.
    Set rs = New ADODB.Recordset
    Debug.Print "ADO RecordSet Created"
   
    If TableRef = "Order" Then
       strsql = "select *, tblTransType.TransDesc AS Expr1 from tblOrder INNER JOIN "
       strsql = strsql & "tblTransType ON tblOrder.TransType=tblTransType.TransTypeKey "
       strsql = strsql & "WHERE (tblOrder.FileNum = '" & Trim(XYZFileNumber()) & "')"
       Debug.Print "SQL SELECT string assigned to varable: " & strsql
    ElseIf TableRef = "Element" Then
       strsql = "SELECT * FROM tblDPElementData INNER JOIN "
       strsql = strsql & "tblOrder ON tblDPElementData.OrderKey = tblOrder.OrderKey INNER JOIN "
       strsql = strsql & "tblDPElement ON tblDPElementData.DPElementKey = tblDPElement.DPElementKey "
       strsql = strsql & "WHERE (tblOrder.FileNum = '" & Trim(XYZFileNumber()) & "') AND "
       strsql = strsql & "(tblDPElement.ElementName = '" & FieldRef & "')"
       Debug.Print "SQL: " & strsql
    ElseIf TableRef = "Property" Then
       strsql = "SELECT * FROM tblOrderPropAddress INNER JOIN tblOrder ON tblOrderPropAddress.OrderKey "
       strsql = strsql & "= tblOrder.OrderKey WHERE (tblOrder.FileNum = '"
       strsql = strsql & Trim(XYZFileNumber()) & "')"
    ElseIf TableRef = "Escrow" Then
       strsql = "SELECT * FROM tblEscrowUnit INNER JOIN tblOrder ON tblEscrowUnit.EscrowUnitNum = "
       strsql = strsql & "tblOrder.EscrowUnit INNER JOIN tblNameAddress ON tblEscrowUnit.NameAddressKey "
       strsql = strsql & "= tblNameAddress.NameAddressKey WHERE (tblOrder.FileNum = '"
       strsql = strsql & Trim(XYZFileNumber()) & "')"
   Else 'If TableRef = "Contact" Then
       Debug.Print "In the Contact SQL String loop"
       strsql = "SELECT * FROM tblOrderParty INNER JOIN "
       strsql = strsql & "tblOrder ON tblOrderParty.OrderKey = tblOrder.OrderKey INNER JOIN "
       strsql = strsql & "tblNameType ON tblOrderParty.NameType = tblNameType.NameTypeKey INNER JOIN "
       strsql = strsql & "tblNameAddress ON tblOrderParty.RecID = tblNameAddress.NameAddressKey "
       strsql = strsql & "WHERE (tblOrder.FileNum = '" & Trim(XYZFileNumber()) & "') "
       strsql = strsql & "AND (tblNameType.NameTypeDesc = '" & TableRef & "') "
       strsql = strsql & "ORDER BY tblOrderParty.SeqNum"
       Debug.Print "SQL: " & strsql
   
    End If
   
    Debug.Print "SQL: " & strsql
    rs.Open strsql, objConn, adOpenStatic
    If rs.State = adStateOpen Then Debug.Print "RecordsSet RS is OPEN!"
    If FieldType = "" Then FieldType = 1 ' The Default if left blank is set to 1
    FieldType = CInt(FieldType) 'Gotta be a number to work with it
 
       
    ' Move to the first record and display the data.
    Debug.Print "Number of records in Recordset:" & rs.RecordCount
   
    If rs.RecordCount = 0 Then
       Debug.Print "RECORDSET IS EMPTY. Looks Like a paramter in the function was not properly specified"
       LinktoXYZ = "NoRecords"
       Exit Function 'THIS IS WHERE IT HANGS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    End If
       
    If rs.RecordCount < (FieldType) Then
       LinktoXYZ = "RecordOutofRange"
       Exit Function
    End If
   
    rs.Move (FieldType - 1)
    Debug.Print "We have moved in Record Set to Record#:" & (FieldType)
    ' Lets get the information requested
   
    If FieldRef = "State" And TableRef = "Order" Then
    LinktoXYZ = rs("statename") ' This is what the functions value will be when called
    ElseIf FieldRef = "County" And TableRef = "Order" Then
    LinktoXYZ = rs("countyname") ' This is what the functions value will be when called
    ElseIf FieldRef = "Escrow" And TableRef = "Order" Then
    LinktoXYZ = rs("escrowunit") ' This is what the functions value will be when called
    ElseIf FieldRef = "TransType" And TableRef = "Order" Then
    LinktoXYZ = rs("transdesc") ' This is what the functions value will be when called
    ElseIf TableRef = "Element" Then
    ' We need code HERE to grab the proper field number, date, etc...
      If rs("ElementDataType") = "Text" Then
      LinktoXYZ= rs("textdata") ' This is what the functions value will be when called
      ElseIf rs("ElementDataType") = "YesNo" Then
      LinktoXYZ = rs("YesNoData") ' This is what the functions value will be when called
      ElseIf rs("ElementDataType") = "Currency" Then
      LinktoXYZ = rs("CurrencyData") ' This is what the functions value will be when called
      ElseIf rs("ElementDataType") = "Number" Then
      LinktoXYZ = rs("NumberData") ' This is what the functions value will be when called
      ElseIf rs("ElementDataType") = "DateTime" Then
      LinktoXYZ = rs("DateTimeData") ' This is what the functions value will be when called
      End If
    Else 'The TableRef was not ORDER or ELEMENT so lets assume it was one of the others like PROPERTY
    Debug.Print "Spot #2"
    LinktoXYZ = rs(FieldRef) ' Gonna need some error control here.
    End If
   
' Code to insure errors appear in a message box
LinktoExit:
rs.Close
objConn.Close
Exit Function
 
LinktoError:
    Debug.Print "LinktoXYZ Function Error: " & Err.Number & " " & Err.Description
    If Err.Number = 3265 Then
       Debug.Print "SQL Error. Likley that an invalid field name was specified as a LinktoXYZ parameter"
    End If
   
    Resume LinktoExit
 
End Function
0
 
bruintjeCommented:
i thought recordcount was always 0 on return

what happens if you change the code to

   If rs.EOF Then
       Debug.Print "RECORDSET IS EMPTY. Looks Like a paramter in the function was not properly specified"
       LinktoXYZ = "NoRecords"
       Goto LinktoExit
    End If
       
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
swendellAuthor Commented:
1. I will try that but recordset is not always zero, there usually will be records returned when I request them.
2. Further, it does properly identify that there are 0 records, that is not the issue. After it successfully identifies that, it moves on to the next lines of code properly until it is asked to exit the proceedure, then it just sits and does nothing......
0
 
bruintjeCommented:
ok just comment here, i'll try to stay current on this
0
 
swendellAuthor Commented:
Possible memory issue? Any tools to trroble shoot you are aware of ?
0
 
swendellAuthor Commented:
I was able to figure this out on my own.
Very obscure and hopefully someone may find this valuable.
One would think VB would throw some type of error rather then just stopping but maybe this is one for Microsoft ?
Here we go:

Calling Subroutine ()
FormatCurrency (linktoxyz() )
end sub

Function linktoxyz ()
linktoxyz = compute some value. Usually a number, otherwise a text error message
end function  'If it was text, it would just stop here and not return to the calling subroutine, otherwise it would return properly


I called my function wrapped in the FormatCurrency function from a standard sub routine as illustrated above.
When my function did not return a numeric value; my function would not properly return to the calling subroutine.
Removing the FormatCurrency function fixed the issue
0
 
bruintjeCommented:
PAQ and refund
0
 
GranModCommented:
PAQed with points refunded (500)

GranMod
Community Support Moderator
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now