Hello,
I have a application in which there is one form, so when I input some things on the form and click on Submit button, notes client and application hangs. It can not be controlled thru Ctrl+Brk after it hangs.
On Submit button simple code is working which is looking data in same database and some loops and conditions are there. It is not connecting to some othere database or external db.
Please suggest me some speculations.
Thanks
Subject: Notes Client Hangs
Please post the code in your submit button so we know what you’re trying to do and can possibly spot an error in your code.
Alex
Subject: RE: Notes Client Hangs
Here is code:
Sub Click(Source As Button)
On Error Goto ErrorHandler
Dim liPopulateApprovers As Integer
Dim CERInitiator As String
Set s=New notessession
Set ws=New NotesUIWorkspace
Set db =s.CurrentDatabase
Set uidoc=ws.CurrentDocument
Set docUI=uidoc.Document
'FIELD VALIDATIONS**************************
If fpfValidateFields(uidoc) = 1 Then
Exit Sub
End If
'END HERE***********************************
'POPULATING WORKFLOW USERS/APPROVERS AND THEIR DESIGNATIONS*****
'IN INITIAL_WORKFLOW_PROCESS & INITIAL_ROUTING*********************
liPopulateApprovers=fpfPopulateApprovers()
If liPopulateApprovers=0 Then
Exit Sub
End If
'ENDS HERE*****************************************************************************************
If uidoc.IsNewDoc Then
'*******Generating CER Sequence Number************
Call fpfCERSequenceNumber()
'**********************************************************
'*******Assigning New CER Sequence Number to CER Field in Setup Document********
Set view=db.GetView("vwSetup")
Set doc=view.GetFirstDocument
'Msgbox newCER_Sequence_Number
doc.CER_Sequence_Number=newCER_Sequence_Number
Call doc.Save(False, False)
'**********************************************************************************************
End If
CERInitiator=uidoc.FieldGetText("CER_Initiator")
Call uidoc.FieldSetText("Request_Status", "")
Call uidoc.Save
'UPDATING HISTORY**************************************************
'Call fpfCERUpdateHistory(CERInitiator , "Submitted to "+uidoc.FieldGetText("CER_CurrentlyWith_Designation"), docUI, uidoc)
'ENDS HERE***********************************************************
Call uidoc.FieldSetText("Request_Status", "Submitted to "+uidoc.FieldGetText("CER_CurrentlyWith_Designation"))
Call uidoc.FieldSetText("CER_Action", "Submit")
Call uidoc.Save
'SENDING MAIL********************************************************
'liSendMail=fpfSendMail(db, uidoc, "Submit")
'If liSendMail=0 Then
' Exit Sub
'End If
'ENDS HERE***********************************************************
Dim agent As notesagent
Set db=s.CurrentDatabase
Set agent=db.GetAgent("(SetAuthorReaders)")
If agent.Run=0 Then
Msgbox "Success"
Else
Msgbox "NO"
End If
'Call uidoc.Save
Call uidoc.Close
Exit Sub
Call uidoc.Close
ErrorHandler:
lsErrorMsg="CER Form -> Submit:"
lsErrorMsg=lsErrorMsg & Chr(13) & " Error: "+Error
lsErrorMsg=lsErrorMsg & Chr(13) & " Error at line number: "+Cstr(Erl)
lsErrorMsg=lsErrorMsg & Chr(13) & " Please contact administrator."
Messagebox lsErrorMsg, MB_OK+MB_ICONSTOP+MB_DEFBUTTON1+MB_APPLMODAL, "Error!!!"
Exit Sub
End Sub
++++++++++++++++++++++++++++++++++
++++++++++++++++++++++++++++++++++
Function fpfPopulateApprovers() As Integer
'#########################################################################################################
'THIS FUNCTION IS POPULATING THE APPROVERS OF THE CURRENT WORKFLOW IN THE INITIAL ROUTING FIELD.
'#########################################################################################################
On Error Goto ErrorHandler
fpfPopulateApprovers=0
Dim viewSetup As notesview
Dim docSetup As notesdocument
Dim viewWrkFlw As Notesview
Dim docWrkFlw As NotesDocument
Dim viewPlant As NotesView
Dim docPlant As notesdocument
Dim itemRoutingUserList As NotesItem
Dim itemProcess_Req As notesitem
Dim itemWrkFlw_Process As notesitem
Dim itemWrkFlw_Process_Remaining As NotesItem
Dim itemName_Remaining As notesitem
Dim CERType As String
Dim CERCategory As String
Dim CERNetCost As Long
Dim CERLocation As String
Dim AllApprover As String
Dim AllApproverList As Variant
Dim UboundApproverList As Integer
Dim CER_Initial_Routing As Variant
Dim NetCostValidation As Long
Dim AllApproverDesignation As String
Dim HOApproverDesignation As String
Dim AllApproverDesig As String
Dim HOApproverDesig As String
Dim lsInitiatorDesignation As String
Dim lsNextApproverDesignation As String
Dim lsNextApproverName As String
Dim lvReaderNames As Variant
Dim itemAuthors As notesitem
Dim itemReaders As notesitem
CER_Initial_Routing=""
'*********Evaluating the WorkFlow Name***************************************************
CERType=uidoc.FieldGetText("CER_Type")
CERCategory=uidoc.FieldGetText("Category")
Call uidoc.FieldSetText("CER_WrkFlw_Name",CERType+"-"+CERCategory)
'-----------End Here---------------------------------------------------------------------------------------------
'********Fetching New Cost Value for validation from Setup Document********************
Set viewSetup=db.GetView("vwSetup")
Set docSetup=viewSetup.GetFirstDocument
If docSetup Is Nothing Then
lsErrorMsg="Unable to find setup information in Setup Information View. Please contact administrator."
Messagebox lsErrorMsg, MB_OK+MB_ICONSTOP+MB_DEFBUTTON1+MB_APPLMODAL, "Error!!!"
Exit Function
End If
CERNetCost=uidoc.FieldGetText("Net_Cost")
NetCostValidation=docSetup.Workflow_NetCost_Validation(0)
'-----------End Here---------------------------------------------------------------------------------------------
'********Selecting the workflow name******************************************************
If CERType="IT" And CERCategory="Plant" Then
wrkFlowKey=CERType+"-"+CERCategory
Elseif CERType="IT" And CERCategory="HO" Then
wrkFlowKey=CERType+"-"+CERCategory
Elseif CERType="Non IT" And CERCategory="Plant" And CERNetCost<=NetCostValidation Then
wrkFlowKey=Fulltrim(CERType)+"-"+CERCategory+"-Less-"+Cstr(NetCostValidation)
Elseif CERType="Non IT" And CERCategory="Plant" And CERNetCost>NetCostValidation Then
wrkFlowKey=Fulltrim(CERType)+"-"+CERCategory+"-Greator-"+Cstr(NetCostValidation)
Elseif CERType="Non IT" And CERCategory="HO" Then
wrkFlowKey=Fulltrim(CERType+"-"+CERCategory)
End If
Set viewWrkFlw=db.GetView("vwSWI")
Set docWrkFlw=viewWrkFlw.GetDocumentByKey(wrkFlowKey)
If docWrkFlw Is Nothing Then
lsErrorMsg="Unable to find workflow details in Workflow Setup Information View. Please contact administrator."
Messagebox lsErrorMsg, MB_OK+MB_ICONSTOP+MB_DEFBUTTON1+MB_APPLMODAL, "Error!!!"
Exit Function
End If
'-----------End Here---------------------------------------------------------------------------------------------
'********Setting the WorkFlow Process from workflow document*********************
Call uidoc.FieldSetText("CER_Initial_WrkFlw_Process", "")
Call uidoc.FieldSetText("CER_WrkFlw_Process_Required", "")
Call uidoc.Refresh
Set itemWrkFlw_Process=docUI.GetFirstItem("CER_Initial_WrkFlw_Process")
Call itemWrkFlw_Process.appendtotextlist(docWrkFlw.Workflow_Process)
Set itemProcess_Req=docUI.GetFirstItem("CER_WrkFlw_Process_Required")
Call itemProcess_Req.appendtotextlist(docWrkFlw.Workflow_Process_Required)
'----------Ends Here---------------------------------------------------------------------------------------
If CERCategory="Plant" Then
CERLocation=uidoc.FieldGetText("Location")
Call uidoc.FieldSetText("CER_Initial_Routing", "")
Call uidoc.Refresh
Set viewPlant=db.GetView("vwPlant")
Set docPlant=viewPlant.GetDocumentByKey(CERLocation, True)
If docPlant Is Nothing Then
lsErrorMsg="Unable to get the location of "+CERLocation+" plant in Plant Setup Information View. Please contact administrator."
Messagebox lsErrorMsg, MB_OK+MB_ICONSTOP+MB_DEFBUTTON1+MB_APPLMODAL, "Error!!!"
Exit Function
End If
AllApprover=docPlant.AllApprovers(0)
AllApproverList=Split(AllApprover,";")
UboundApproverList=Ubound(AllApproverList)
Forall v In itemWrkFlw_Process.Values
If CERType="Non IT" And v="Initiator" Then
If CER_Initial_Routing="" Then
CER_Initial_Routing=uidoc.FieldGetText("CER_Initiator_User_ID")
Else
CER_Initial_Routing=CER_Initial_Routing+";"+uidoc.FieldGetText("CER_Initiator_User_ID")
End If
End If
If (CERType="IT" Or CERType="Non IT") And v="Department Head" And uidoc.FieldGetText("Dept_Head")<>"" Then
DeptHead=uidoc.FieldGetText("Dept_Head")
If CER_Initial_Routing="" Then
CER_Initial_Routing=DeptHead
Else
CER_Initial_Routing=CER_Initial_Routing+";"+DeptHead
End If
Elseif (CERType="IT" Or CERType="Non IT") And v="Department Head" And uidoc.FieldGetText("Dept_Head")="" Then
AllApproverDesig=uidoc.FieldGetText("CER_Initial_WrkFlw_Process")
itemWrkFlw_Process.Values=""
Call itemWrkFlw_Process.appendtotextlist(Fulltrim(Replace(AllApproverDesig, "Department Head;", "")))
End If
If CERType="Non IT" And v="EHS MR" And (uidoc.fieldgettext("Impact_Environment")<>"None" And uidoc.fieldgettext("Impact_Environment")<>"") Then
If CER_Initial_Routing="" Then
CER_Initial_Routing=docPlant.EHS_MR(0)
Else
CER_Initial_Routing=CER_Initial_Routing+";"+docPlant.EHS_MR(0)
End If
Elseif CERType="Non IT" And v="EHS MR" And (uidoc.fieldgettext("Impact_Environment")="None" Or uidoc.fieldgettext("Impact_Environment")="") Then
AllApproverDesig=uidoc.FieldGetText("CER_Initial_WrkFlw_Process")
itemWrkFlw_Process.Values=""
Call itemWrkFlw_Process.appendtotextlist(Fulltrim(Replace(AllApproverDesig, "EHS MR;", "")))
End If
For counter=0 To UboundApproverList
AllApproverDesignation=Fulltrim(Strleftback(AllApproverList(counter), " - "))
If Strcomp(v, AllApproverDesignation) =0 Then
If Strrightback(AllApproverList(counter), "- ")<>"" Then
'If Instr(1, AllApproverList(counter), v) > 0 Then
If CER_Initial_Routing="" Then
CER_Initial_Routing=Strrightback(AllApproverList(counter), "- ")
Else
CER_Initial_Routing=CER_Initial_Routing+";"+Strrightback(AllApproverList(counter), "- ")
End If
Else
AllApproverDesig=uidoc.FieldGetText("CER_Initial_WrkFlw_Process")
itemWrkFlw_Process.Values=""
Call itemWrkFlw_Process.appendtotextlist(Fulltrim(Replace(AllApproverDesig, AllApproverDesignation+";", "")))
End If
End If
Next
End Forall
Set itemRoutingUserList=docUI.GetFirstItem("CER_Initial_Routing")
CER_Initial_Routing=Fulltrim(CER_Initial_Routing)
Call itemRoutingUserList.appendtotextlist(CER_Initial_Routing)
Elseif CERCategory="HO" Then
CERLocation=uidoc.FieldGetText("Location")
Call uidoc.FieldSetText("CER_Initial_Routing", "")
Call uidoc.Refresh
Set viewHO=db.GetView("vwHO")
Set docHO=viewHO.GetDocumentByKey(CERLocation, True)
If docHO Is Nothing Then
lsErrorMsg="Unable to get the HO Setup Information View. Please contact administrator."
Messagebox lsErrorMsg, MB_OK+MB_ICONSTOP+MB_DEFBUTTON1+MB_APPLMODAL, "Error!!!"
Exit Function
End If
HOApprover=docHO.HOApprovers(0)
HOApproverList=Split(HOApprover,";")
UboundApproverList=Ubound(HOApproverList)
Forall v In itemWrkFlw_Process.Values
If CERType="Non IT" And v="Initiator" Then
If CER_Initial_Routing="" Then
CER_Initial_Routing=uidoc.FieldGetText("CER_Initiator_User_ID")
Else
CER_Initial_Routing=CER_Initial_Routing+";"+uidoc.FieldGetText("CER_Initiator_User_ID")
End If
End If
If (CERType="IT" Or CERType="Non IT") And v="Department Head" And uidoc.FieldGetText("Dept_Head")<>"" Then
DeptHead=uidoc.FieldGetText("Dept_Head")
If CER_Initial_Routing="" Then
CER_Initial_Routing=DeptHead
Else
CER_Initial_Routing=CER_Initial_Routing+";"+DeptHead
End If
Elseif (CERType="IT" Or CERType="Non IT") And v="Department Head" And uidoc.FieldGetText("Dept_Head")="" Then
HOApproverDesig=uidoc.FieldGetText("CER_Initial_WrkFlw_Process")
itemWrkFlw_Process.Values=""
Call itemWrkFlw_Process.appendtotextlist(Fulltrim(Replace(HOApproverDesig, "Department Head;", "")))
End If
If CERType="Non IT" And v="HO EHS MR" And (uidoc.fieldgettext("Impact_Environment")<>"None" And uidoc.fieldgettext("Impact_Environment")<>"") Then
If CER_Initial_Routing="" Then
CER_Initial_Routing=docHO.HO_EHS_MR(0)
Else
CER_Initial_Routing=CER_Initial_Routing+";"+docHO.HO_EHS_MR(0)
End If
Elseif CERType="Non IT" And v="HO EHS MR" And (uidoc.fieldgettext("Impact_Environment")="None" Or uidoc.fieldgettext("Impact_Environment")="") Then
HOApproverDesig=uidoc.FieldGetText("CER_Initial_WrkFlw_Process")
itemWrkFlw_Process.Values=""
Call itemWrkFlw_Process.appendtotextlist(Fulltrim(Replace(HOApproverDesig, "HO EHS MR;", "")))
End If
For counter=0 To UboundApproverList
HOApproverDesignation=Fulltrim(Strleftback(HOApproverList(counter), " - "))
If Strcomp(v, HOApproverDesignation) =0 Then
If Strrightback(HOApproverList(counter), "- ")<>"" Then
'If Instr(1, HOApproverList(counter), v) > 0 Then
If CER_Initial_Routing="" Then
CER_Initial_Routing=Strrightback(HOApproverList(counter), "- ")
Else
CER_Initial_Routing=CER_Initial_Routing+";"+Strrightback(HOApproverList(counter), "- ")
End If
Else
HOApproverDesig=uidoc.FieldGetText("CER_Initial_WrkFlw_Process")
itemWrkFlw_Process.Values=""
Call itemWrkFlw_Process.appendtotextlist(Fulltrim(Replace(HOApproverDesig, HOApproverDesignation+";", "")))
End If
End If
Next
End Forall
Set itemRoutingUserList=docUI.GetFirstItem("CER_Initial_Routing")
CER_Initial_Routing=Fulltrim(CER_Initial_Routing)
Call itemRoutingUserList.appendtotextlist(CER_Initial_Routing)
End If
'POPULATING APPROVERS IN REMAINING ROUTING FIELD*****************************************************************
Set itemWrkFlw_Process_Initial=docUI.GetFirstItem("CER_Initial_WrkFlw_Process")
lsInitiatorDesignation=itemWrkFlw_Process_Initial.Values(0)
Set itemName_Initial=docUI.GetFirstItem("CER_Initial_Routing")
If (itemName_Initial Is Nothing) Then
lsErrorMsg="Approvers not found. Please contact administrator."
Messagebox lsErrorMsg, MB_OK+MB_ICONSTOP+MB_DEFBUTTON1+MB_APPLMODAL, "Error!!!"
Exit Function
End If
lsInitiatorName=Fulltrim(Strleft(itemName_Initial.values(0), ";"))
lsNextApproverName=Fulltrim(Strleft(Strright(itemName_Initial.Values(0), ";"), ";"))
'-----COMPARE INITIATOR WITH NEXT LEVEL APPROVER----------------------------------
If(lsInitiatorName=lsNextApproverName) Then
Set itemWrkFlw_Process_Remaining=docUI.GetFirstItem("CER_Remaining_WrkFlw_Process")
Call itemWrkFlw_Process_Remaining.AppendToTextList(Strright(Strright(Implode(itemWrkFlw_Process_Initial.Values, "; "), ";"), ";"))
Set itemName_Remaining=docUI.GetFirstItem("CER_Remaining_Routing")
Call itemName_Remaining.AppendToTextList(Strright(Strright(itemName_Initial.Values(0), ";"), ";"))
lsNextApproverDesignation=Fulltrim(Strleft(Strright(Implode(itemWrkFlw_Process_Initial.Values, "; "), ";"), ";"))
'Call fpfCERUpdateHistory(lsNextApproverName , "Approved by "+lsNextApproverDesignation, docUI, uidoc)
lsNextApproverName=Fulltrim(Strleft(Strright(Strright(itemName_Initial.Values(0), ";"), ";"), ";"))
lsNextApproverDesignation=Fulltrim(Strleft(Strright(Strright(Implode(itemWrkFlw_Process_Initial.Values, "; "), ";"), ";"), ";"))
Else
Set itemWrkFlw_Process_Remaining=docUI.GetFirstItem("CER_Remaining_WrkFlw_Process")
Call itemWrkFlw_Process_Remaining.AppendToTextList(Strright(Implode(itemWrkFlw_Process_Initial.Values, "; "), ";"))
Set itemName_Remaining=docUI.GetFirstItem("CER_Remaining_Routing")
Call itemName_Remaining.AppendToTextList(Strright(itemName_Initial.Values(0), ";"))
lsNextApproverName=Fulltrim(Strleft(Strright(itemName_Initial.Values(0), ";"), ";"))
lsNextApproverDesignation=Fulltrim(Strleft(Strright(Implode(itemWrkFlw_Process_Initial.Values, "; "), ";"), ";"))
End If
'-----ENDS HERE------------------------------------------------------------------------------------------
'ENDS HERE****************************************************************************************************************
'POPULATING APPROVER & DESIGNATION IN CURRENTLYWITH FIELD*****************************************************************
’ Dim itemCurrentlyWithName As notesitem
’ Set itemCurrentlyWithName=docUI.GetFirstItem(“CER_CurrentlyWith_Name”)
’ itemCurrentlyWithName.Values=lsNextApproverName
Call uidoc.FieldSetText("CER_CurrentlyWith_Name",lsNextApproverName)
’ Dim itemCurrentlyWithDesig As notesitem
’ Set itemCurrentlyWithDesig=docUI.GetFirstItem(“CER_CurrentlyWith_Designation”)
'itemCurrentlyWithDesig.Values=lsNextApproverDesignation
Call uidoc.FieldSetText("CER_CurrentlyWith_Designation",lsNextApproverDesignation)
'ENDS HERE****************************************************************************************************************
'POPULATING APPROVER IN AUTHORS & READERS FIELD*****************************************************************
'Call uidoc.FieldSetText("CER_Authors", lsNextApproverName)
'Set itemAuthors=docUI.GetFirstItem("CER_Authors")
'Call itemAuthors.appendtotextlist(lsNextApproverName)
'lvReaderNames=Split("")
'lvReaderNames=Fulltrim(Arrayappend(lvReaderNames,lsInitiatorName))
'lvReaderNames=Fulltrim(Arrayappend(lvReaderNames,lsNextApproverName))
'Call uidoc.FieldAppendText("CER_Readers", Fulltrim(Implode(lvReaderNames, ";")))
'Set itemReaders=docUI.GetFirstItem("CER_Readers")
'Call itemReaders.appendtotextlist(lvReaderNames)
'ENDS HERE****************************************************************************************************************
fpfPopulateApprovers=1
Exit Function
CleanUp:
Exit Function
ErrorHandler:
lsErrorMsg="CER Form -> Submit -> Populating Approver:"
lsErrorMsg=lsErrorMsg & Chr(13) & " Error: "+Error
lsErrorMsg=lsErrorMsg & Chr(13) & " Error at line number: "+Cstr(Erl)
lsErrorMsg=lsErrorMsg & Chr(13) & " Please contact administrator."
Messagebox lsErrorMsg, MB_OK+MB_ICONSTOP+MB_DEFBUTTON1+MB_APPLMODAL, "Error!!!"
Goto CleanUp
End Function