When doing a heavy job with VBA in Lime CRM, for example creating/updating many records at the same time, it could be a good idea to show the progress to the user. In the examples we create 1000 companies in smaller batches and shows the progress. Here's a few examples of how:
Dim i As Integer Dim j As Integer Dim oRecord As LDE.Record Dim oBatch As New LDE.Batch Set oBatch.Database = Application.Database ' Do 10 batches For j = 0 To 10 'Batches of 100 at the time For i = 0 To 100 Set oRecord = New LDE.Record Call oRecord.Open(Application.Database.Classes.Lookup("company", lkLookupClassByName)) oRecord.value("name") = "Company nummero - " & (j * 100 + i) Call oRecord.Update(oBatch) Next i Call oBatch.Execute ' Update text and progress Application.StatusBar.Text = "Creating " & (j * 100) & " / 1000 companies" ' Progressbar is not visible if progress 0, so set a minimum of 1. If j = 0 Then Application.StatusBar.Progress = 1 Else Application.StatusBar.Progress = 100 * ((j * 100) / 1000) End If Next j ' Remove Progressbar Application.StatusBar.Progress = 0 Application.StatusBar.Text = ""
A work dialog is a small popup window that shows a progress bar with som text and can also have a cancel button.
Name | Required | Type | Description |
---|---|---|---|
Cancel | False | Boolean | Indicates if the user has pressed Cancel button |
CancelText | False | String | Text on Cancel button |
Caption | False | String | Title of the WorkDialog window |
Delay | False | Long | Will look into it |
Icon | False | IPictureDisp | What icon to show in the WorkDialog window |
Progress | False | Long | A number between 1 and 100 that indicates the progress of the bar |
Style | True | WorkDialogStyle (Enumeration) | Indicates what should be visible and not in the workDialog (If you want to use multiple styles just add them to eachother e.g. .Style = lcoShowCancelButton + lcoShowText) |
lcoShowCancelButton - Show cancel button (Also set CancelText) | |||
lcoShowIcon - Show icon in in workDialog (Also set Icon) | |||
lcoShowProgressBar - Show progress bar (Also set Progress) | |||
lcoShowText - Show text in workDialog (Also set Text) | |||
lcoShowTopMost - Makes the window topmost | |||
Text | False | String | The text that is shown inside the WorkDialog |
Private WithEvents m_WorkDialog As LCO.WorkDialog
Dim oIcon As IPictureDisp Set m_WorkDialog = New LCO.WorkDialog Set oIcon = LoadPicture(WebFolder & "/resources/MyIcons/progress_bar.ico", , , color) ' Of course the icon must exist at the given path. Set m_WorkDialog.Icon = oIcon m_WorkDialog.Caption = "Create companies!" m_WorkDialog.CancelText = "Cancel" m_WorkDialog.Text = "Preparing..." m_WorkDialog.Progress = 1 m_WorkDialog.Style = lcoShowCancelButton + lcoShowProgressBar + lcoShowText + lcoShowIcon Call m_WorkDialog.show
'Event for Cancel-button Private Sub m_WorkDialog_Cancel() On Error GoTo ErrorHandler m_WorkDialog.Cancel = True Call Lime.MessageBox("Cancelled") Exit Sub ErrorHandler: Call UI.ShowError("ControlsHandlerCompany.m_WorkDialog_Cancel") End Sub 'Event for doing the heavy job. (Creating companies in this case) Private Sub m_WorkDialog_Work() On Error GoTo ErrorHandler Dim i As Integer Dim j As Integer Dim oRecord As LDE.record Dim oBatch As New LDE.Batch Set oBatch.Database = Application.Database ' Do 10 batches For j = 0 To 10 'Is it cancelled? If m_WorkDialog.Cancel Then Exit For Else 'Batches of 100 at the time For i = 0 To 100 'Is it cancelled? If m_WorkDialog.Cancel Then Exit For Else Set oRecord = New LDE.record Call oRecord.Open(Application.Database.Classes.Lookup("company", lkLookupClassByName)) oRecord.Value("name") = "Company nummero - " & (j * 100 + i) Call oRecord.Update(oBatch) End If Next i 'Is it not cancelled? If Not m_WorkDialog.Cancel Then Call oBatch.Execute End If ' Update text and progress m_WorkDialog.Text = "Creating: " & (j * 100) & " / 1000" ' Progressbar is not visible if progress 0, so set a minimum of 1. If j = 0 Then m_WorkDialog.progress = 1 Else m_WorkDialog.progress = 100 * ((j * 100) / 1000) End If End If Next j Exit Sub ErrorHandler: Call UI.ShowError("ControlsHandlerCompany.m_WorkDialog_Work") End Sub