Dynamics Community Forum Thread Details

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

VBA 6908 Error Message SL 7.0 SP4

Helpful resources

Quick Links

Congratulations 2024 Spotlight Honorees

Meet the Top 10 leaders for December

Start Your Super User Journey

Leaderboard

Featured topics

Product updates