2950 Error Running Access Macro(Run Code)

StampIT
StampIT used Ask the Experts™
on
When I run a macro I get "Action Failed" Error 2950. The macro has one RunCode statement which runs a function. This public function runs fine if I execute it within the module. Also a similar function runs fine in the macro. The difference between the two functions is the one that works calls a query as in "Set rsBOL = db.OpenRecordset('qrsBOL)" whereas the the one that errors calls a Select statement as in "Set rsBOL = db.OpenRecordset(strSQL)". Code for the non working function is attached.
Public Function BOLData()
 
Dim db As Database
Dim rsBOL As Recordset
Dim rsBOL2 As Recordset
Dim intBOLIndex As Integer
Dim BOLWt As Single
Dim strSpace As String
Dim strDt As String
Dim strTm As String
Dim strC As String
Dim strDate As String
Dim strSQL As String
 
On Error GoTo BOLData_Err
BOLData = True
Set db = CurrentDb
db.Execute "qrdBOL"
strSpace = " "
strDt = "yymmdd"
strTm = "hhmmss"
strC = "C"
strDate = "9/22/2009"
 
strSQL = "SELECT tblCust.Name, PUB_BOLHead.BOLNum, PUB_BOLHead.ShipDate, PUB_BOLHead.CustNum, " & _
"PUB_BOLHead.ProNumber, PUB_BOLHead.BOLType, PUB_BOLDetail.Packages, PUB_BOLDetail.PkgCode, PUB_BOLDetail.Weight, " & _
"PUB_BOLDetail.PkgClass, tblCust.EDICode, tblCust.SupplierNumber, Format(Now()," & Chr(34) & strTm & Chr(34) & ") " & _
"AS CurTime, Format(Now()," & Chr(34) & strDt & Chr(34) & ") AS CurDate, PUB_BOLHead.Carrier " & _
"FROM (PUB_BOLHead INNER JOIN PUB_BOLDetail ON PUB_BOLHead.BOLNum = PUB_BOLDetail.BOLNum) " & _
"INNER JOIN tblCust ON PUB_BOLHead.CustNum = tblCust.CustNum " & _
"WHERE ((PUB_BOLHead.ShipDate) = #" & [Forms]![frmASNDataEntry]![txtShipDate] & "#) " & _
"And ((PUB_BOLHead.CustNum) = " & [Forms]![frmASNDataEntry]![cmbCustNum] & ") " & _
"And ((PUB_BOLHead.BOLType) = " & Chr(34) & strC & Chr(34) & ") " & _
"ORDER BY PUB_BOLHead.BOLNum;"
 
Set rsBOL = db.OpenRecordset(strSQL)        'Source Data
Set rsBOL2 = db.OpenRecordset("tblBOL")     'Table of reorganized BOL data
 
intBOLIndex = 0
BOLWt = 0
 
rsBOL.MoveFirst
 
'If the BOL number and the package classification are the same add to the index in the same record.
While Not rsBOL.EOF
    If rsBOL2!BOLNum = rsBOL!BOLNum And rsBOL2!PkgClass = rsBOL!PkgClass Then
        intBOLIndex = intBOLIndex + 1
    Else
        rsBOL2!TotWeight = BOLWt        'assigning total BOL weight prior to updating the tblBOL
        rsBOL2.Update                   'write data to the tblBOL before proceeding to the next record
        BOLWt = 0
        intBOLIndex = 1
        rsBOL2.AddNew                   'Add new record
        rsBOL2!SendRcvID = rsBOL!EDICode
        rsBOL2!BOLNum = rsBOL!BOLNum
        rsBOL2!ASNum = rsBOL!BOLNum
        rsBOL2!CustNum = rsBOL!CustNum
        rsBOL2!CustName = rsBOL!Name
        rsBOL2!ShipDate = rsBOL!ShipDate
        rsBOL2!ProNumber = rsBOL!ProNumber
        rsBOL2!PkgClass = rsBOL!PkgClass
        rsBOL2!SupCode = rsBOL!SupplierNumber
        rsBOL2!ASNDate = rsBOL!CurDate
        rsBOL2!ASNTime = rsBOL!CurTime
    End If
    'using intBOLIndex as part of the field name. Index increases by one during each pass within a record.
    rsBOL2("PkgCode" & intBOLIndex) = rsBOL!PkgCode
    rsBOL2("NumPackages" & intBOLIndex) = rsBOL!Packages
    rsBOL2("Weight" & intBOLIndex) = rsBOL!Weight
    
    BOLWt = BOLWt + rsBOL!Weight    'Summing BOL Weight for each pass in the same BOL and class
    
    rsBOL.MoveNext
    
    If rsBOL.EOF Then       'If at end of qrsBOL update tblBOL with the last record because the While loop will not execute again
        rsBOL2!TotWeight = BOLWt
        rsBOL2.Update
    End If
    
Wend
       
BOLData_Exit:
    Set rsBOL = Nothing
    Set rsBOL2 = Nothing
    db.Close
    MsgBox "BOLData has finished", vbOKOnly + vbInformation + vbSystemModal, "BOLData Complete"
    Exit Function
 
BOLData_Err:
    If Err.Number = 3021 Then           'first time through
        If intBOLIndex = 0 Then
            rsBOL2.AddNew               'Add first record
            rsBOL2!SendRcvID = rsBOL!EDICode
            rsBOL2!BOLNum = rsBOL!BOLNum
            rsBOL2!ASNum = rsBOL!BOLNum
            rsBOL2!CustNum = rsBOL!CustNum
            rsBOL2!CustName = rsBOL!Name
            rsBOL2!ShipDate = rsBOL!ShipDate
            rsBOL2!ProNumber = rsBOL!ProNumber
            rsBOL2!PkgClass = rsBOL!PkgClass
            rsBOL2!SupCode = rsBOL!SupplierNumber
            rsBOL2!ASNDate = rsBOL!CurDate
            rsBOL2!ASNTime = rsBOL!CurTime
        End If
        Resume Next
    Else
        MsgBox "The following error occurred in BOLData" & Chr(13) _
        & "Error # " & str(Err.Number) & " was generated by " _
        & Err.Source & Chr(13) & Err.Description
        BOLData = False
        Resume BOLData_Exit
    End If
        
End Function

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2016

Commented:
open your macro in design view

check the function name argument is like this

Function Name    BOLData()

Author

Commented:
capricorn1,
     The function name argument is already BOLData(). That's not it. Thanks
Programmer
Commented:
Place a break point on line 17 of your function and run the Macro.  I do not believe it will reach that point.  That means the problem is with your macro not your function.  I would delete and rebuild the macro from scratch at that point.  If it does break on line 17 then step to the line that causes the code exit as it is not reaching your error handler.  Let me know how it goes.

Author

Commented:
BillDenver,
         I did not insert a breakpoint but I decided to create a new macro. In that process I discovered that somehow I had another function of the same name. When I deleted the duplicate the macro fan fine. Thanks.
Bill RossProgrammer

Commented:
Thank you, Hope I helped.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial