I am building a VBA Customization on the Flex Billings Schedules Billings and Revenue screen that will auto build the Revenue tab (PJBSREV) line items based on the values in the Billings tab (PJBSDET).
The cmdButton will delete any unreleased PJBSREV line items and re-populate the grid, based on a number of variables. In short, it seems to be working as required, except that I get a 6908 error message when trying to save the updates.
I think the problem exists in the CallRevGridUpdate(), as I still get the error if I delete the existing records manually using the screen (but not saving after deleting).
The code is below; any help is greatly appreciated. Thanks in advance!!!!
Private Sub cmdCreateRevSched_Click()
Dim retval As Integer
Dim xrow As Integer
xProjectID = Trim$(GetObjectValue("cproject"))
xSchedNbr = Trim$(GetObjectValue("cschednbr"))
'Load PJBSREV table values into memory array
mem_array2 = VBA_MOpen(bPJBSREV, LenB(bPJBSREV), "", 0, "", 0, "", 0)
SQLStr = "select * from pjbsrev where project = " & SParm(xProjectID) & _
" and schednbr = " & SParm(xSchedNbr) & _
" and rel_status = 'Y'"
Call SqlCursorEx(CSR_xfetch2, NOLEVEL, "CSR_xfetch", "bPJBSREV", "")
retval = SqlFetch1(CSR_xfetch2, SQLStr, bPJBSREV, LenB(bPJBSREV))
GridValue = GetGridHandle("ssrevenue")
xrowcnt = mrowcnt(GridValue)
If retval <> 0 Then
If xrowcnt > 0 Then
Call MessBox("This will overwrite existing revenue records; do you want to continue?", MB_YESNO, "System Message")
If (MessResponse() = IDYES) Then
CallDeleteRevGrid
CallRevGridUpdate
End If
Else
CallRevGridUpdate
End If
Else
Call MessBox("At least one revenue record has been released; you must make changes manually.", MB_OK, " System Message")
End If
End Sub
Private Sub CallDeleteRevGrid()
GridValue = GetGridHandle("ssrevenue")
xrowcnt = mrowcnt(GridValue)
Call MFirst(GridValue, MaintFlag)
While xrowcnt > 0
Call MDelete(GridValue, DELETED)
serr = MSetLineStatus(mem_array2, DELETED)
Call MUpdate(mem_array2)
xrowcnt = mrowcnt(GridValue)
Wend
Call MDisplay(GridValue)
End Sub
Private Sub CallRevGridUpdate()
Dim xEndDate As Sdate
Dim xTask$, xRevAmt As Double
xProjectID = Trim$(GetObjectValue("cproject"))
xSchedNbr = Trim$(GetObjectValue("cschednbr"))
'Call stored procedure to load required data into temporary table
SQLStr2 = "sp_QBI_PJBSRevBuild" + SParm(xProjectID) + SParm(xSchedNbr)
Call sql(CSR_xbuild, SQLStr2)
'Load temp table values into memory array
mem_array = VBA_MOpen(bQBI_PJBSREV, LenB(bQBI_PJBSREV), "", 0, "", 0, "", 0)
'Select required values from temporary table
SQLStr3 = "select * from QBI_PJBSRev where project = " & SParm(xProjectID) & _
" and schednbr = " & SParm(xSchedNbr) & _
" order by row"
Call SqlCursorEx(CSR_xfetch, NOLEVEL, "CSR_xfetch", "bQBI_PJBSREV", "")
serr = SqlFetch1(CSR_xfetch, SQLStr3, bQBI_PJBSREV, LenB(bQBI_PJBSREV))
Call MFirst(GridValue, MaintFlag)
While serr = 0
xrow = bQBI_PJBSREV.row
xTask = Trim$(bQBI_PJBSREV.pjt_entity)
xEndDate = bQBI_PJBSREV.end_date
xEndDateStr = DateToStr(xEndDate)
xRevAmt = bQBI_PJBSREV.rev_amount
sivMyApp.Controls("clinenbrREV") = xrow
sivMyApp.Controls("cpjt_entityREV") = xTask
sivMyApp.Controls("cgl_acct") = "302000"
sivMyApp.Controls("cgl_subacctREV") = "0"
serr = SetObjectValue("cpost_dateREV", xEndDateStr)
serr = SetObjectValue("cpost_date_estREV", xEndDateStr)
sivMyApp.Controls("cpercentREV") = 0
sivMyApp.Controls("camountREV") = xRevAmt
Call MInsert(mem_array)
retval = MSetLineStatus(GridValue, NEWROW)
Call MUpdate(GridValue)
serr = SFetch1(CSR_xfetch, bQBI_PJBSREV, LenB(bQBI_PJBSREV))
Wend
Call MDisplay(GridValue)
Call SqlFree(CSR_xfetch)
Call SetLevelChg(LEVEL2, UPDATED)
End Sub
6,451
Share
Report
All responses (
Answers (
