Progress Bar Not Moving - Microsoft Access Forum


	Back to Access Forum Comments List

Upload Images @Reply Bookmark Link Email Next Unseen

Progress Bar Not Moving

Jennifer Neighbors

3 years ago

Greetings! I have Form A which has a long loop, and Form B which opens to display a progress bar and an abort button. I am attempting to update the progress bar on Form B from Form A's loop. There are plenty of DoEvents statements inside that loop. The progress bar (Form B) doesn't appear to move until I press the Abort button. Then, it displays as it should. The Abort button has DoEvents behind it, so this makes sense. Thinking I needed more regular DoEvents on Form B, I set a timer interval of 1000 to fire off a DoEvents Procedure every second. It didn't help. Does anyone else place their progress bar on a form other than where the loop code resides? Can anyone suggest how to solve this? Help would be much appreciated!

	Kevin Robertson @Reply 3 years ago
Screenshots? Code?

Jennifer Neighbors OP @Reply

3 years ago

Here is the code in the Send_Emails_Form that loops through the recipients selected in the list box and sends messages. It also controls what's happening on the Email_Status_Form:

Private Sub MyBar(PercentageComplete As Integer)
'
' pBarFront and pBarBack are text boxes that overlap to create
' the progress bar on the Email_Status_Form.
'
Forms!frmEmailStatus.pBarFront.Width = Forms!frmEmailStatus.pBarBack.Width * (PercentageComplete / 100)
DoEvents

End Sub

Private Sub cmdSend_Click()
'
' The code uses late binding (no reference to Outlook needed)
' which means it can run with different versions of Outlook installed.
' To send the email as HTML, you will need to format the body with
' HTML tags and set the HTMLBody property of the olMailItem (email)
' as shown below.
'
Dim FirstName As String, LastName As String, email As String, body_ As Variant, Signature As Variant
Dim oOutlook As Object
Dim bStarted As Boolean
Dim lngCounter As Long
Dim x As Integer
Dim lngSelectedCount As Long

' Make sure user selected at least one recipient
lngSelectedCount = Me.lstRecipients.ItemsSelected.Count
If lngSelectedCount = 0 Then
 MsgBox "Please select one or more names from the list.", vbOKOnly, "Information Required"
 Exit Sub
End If

On Error Resume Next

DoCmd.OpenForm "frmEmailStatus"

' GetObject if Outlook already running, CreateObject if it's not??
Set oOutlook = GetObject(, "Outlook.Application")
If Err <> 0 Then
 Set oOutlook = CreateObject("Outlook.Application")
 bStarted = True
End If

Set ctl = Me.lstRecipients

If Me.SenderOrganizationNameBold = True Then
 Signature = " " & Me.SenderName & ", " _
 & " " & Me.SenderCompanyOrOrganization & " "
Else
 Signature = " " & Me.SenderName & ", " _
 & Me.SenderCompanyOrOrganization
End If

lngCounter = 0
For x = 0 To 100
 For Each varItm In ctl.ItemsSelected
 lngCounter = lngCounter + 1
 x = x + (100 / lngSelectedCount)
 MyBar x
 ' Lookup email values
 FirstName = DLookup("FirstName", "tblRecipients", "RecipientID = " & Me.lstRecipients.Column(0, varItm))
 LastName = DLookup("LastName", "tblRecipients", "RecipientID = " & Me.lstRecipients.Column(0, varItm))
 email = DLookup("EmailAddress", "tblRecipients", "RecipientID = " & Me.lstRecipients.Column(0, varItm))

 'build body
 body_ = " Dear " & FirstName & " " & LastName & ", " _
 & Me.txtMessage & " " & _
 Signature
 DoEvents
 'send email
 With oOutlook
 With .CreateItem(0) 'olMailItem
 .BodyFormat = 2 'olFormatHTML
 .To = email
 .From = Me.FromEmailAddress
 .CC = Me.CarbonCopyEmailAddress
 .BCC = Me.BlindCarbonCopyEmailAddress
 .Subject = Me.Subject
 .HTMLBody = "<html><body>" & body_ & " <IMG src= '" & PathToLogoImageFile & "' width= 150 align=baseline></body></html>"
 ' .Display
 .Send
 End With
 End With
 DoEvents

 '
 ' Check to see if the user aborted the send emails
 ' action. If they did, exit the loop and hop out.
 '
 If Forms!frmEmailStatus.txtStatus <> "Go" Then
 DoCmd.Close acForm, "frmEmailStatus"
 MsgBox lngCounter & " emails sent."
 Exit Sub
 End If
 DoEvents
 ' Sleep for five seconds - pause between sending emails
 SleepSec (5)
 DoEvents

 Next varItm
Next

DoCmd.Close acForm, "frmEmailStatus"

MsgBox lngCounter & " emails sent."

Set oOutlook = Nothing

End Sub

After I pasted this code here, the icon for uploading images is no longer visible, so I cannot include screenshots. I'm not sure why...

	Jennifer Neighbors OP @Reply 3 years ago

	Jennifer Neighbors OP @Reply 3 years ago

	Jennifer Neighbors OP @Reply 3 years ago

Kevin Robertson @Reply

3 years ago

I built a simplified version and when I removed On Error Resume Next I came across a number of errors and when I selected 3 recipients each was sent 2 Emails. I modified the code to eliminate the problems (again simplified). You can use this to modify your own code, if necessary. Check for errors first. Also Debug -- Compile.

Private Sub btnSend_Click()



    Dim FirstName As String, LastName As String, Email As String

    Dim eBody As Variant, ctl As ListBox, varItm As Variant

    Dim lngCounter As Long, X As Integer, lngSelectedCount As Long

    Dim oOutlook As Object



    lngSelectedCount = lstRecipients.ItemsSelected.Count

    If lngSelectedCount = 0 Then

        MsgBox "Please select one or more names from the list.", vbOKOnly, "Information Required"

        Exit Sub

    End If

    

    On Error GoTo Errorhandler

    

    DoCmd.OpenForm "EmailStatusF"



    Set oOutlook = CreateObject("Outlook.Application")

    Set ctl = lstRecipients

              

    lngCounter = 0

    For X = 0 To 100

        For Each varItm In ctl.ItemsSelected

            FirstName = DLookup("FirstName", "CustomerT", "CustomerID = " & lstRecipients.Column(0, varItm))

            LastName = DLookup("LastName", "CustomerT", "CustomerID = " & lstRecipients.Column(0, varItm))

            Email = DLookup("Email", "CustomerT", "CustomerID = " & lstRecipients.Column(0, varItm))



            eBody = " Dear " & FirstName & " " & LastName & ", " _

                  & "This is a test message!" & "
"



            While Not chkAbort And lngCounter < lngSelectedCount

                With oOutlook.CreateItem(0) 'olMailItem

                    .BodyFormat = 2 'olFormatHTML

                    .To = Email

                    .Subject = "Test Subject"

                    .HTMLBody = "" & eBody & "
"

                    .Send

                End With

                lngCounter = lngCounter + 1

                X = X + (100 / lngSelectedCount)

                MyBar X

                SleepSec (5)

            Wend

        Next varItm

    Next



ErrExit:

    DoCmd.Close acForm, "EmailStatusF"

    MsgBox lngCounter & " emails sent."

    Set oOutlook = Nothing

    Set ctl = Nothing

    

    Exit Sub

    

Errorhandler:

    MsgBox Err.Description, vbExclamation, "Error"

    Resume ErrExit

   

End Sub

	Kevin Robertson @Reply 3 years ago
For the Abort button I added a Check Box to the Send Email Form (Hide it if you don't want to see it). I named the Check Box chkAbort. I added this code to the Email Status Form: `Private Sub btnAbort_Click() Forms!EmailF!chkAbort = True End Sub Private Sub Form_Load() Forms!EmailF!chkAbort = False End Sub`

Jennifer Neighbors OP @Reply

3 years ago

Thank you for taking the time to do all this. Despite repeated testing, I never got two emails to the same person, and I am not sure why that happened to you... Regardless, I will examine this code line by line and see where your code may be better. Indeed, adding the error handling as you did is much better. I originally posted this because my progress bar didn't move until I pressed "Abort." Do you have a suggestion about that? Thanks again!

	Kevin Robertson @Reply 3 years ago
After further testing I discovered the While Loop was causing each Email to be sent to the same person so I replaced it with an If...Then.

	Jennifer Neighbors OP @Reply 3 years ago
Hmm. Okay, I will look at that. Were you able to test the progress bar on the Email Status Form?

	Kevin Robertson @Reply 3 years ago
Yes. It was working fine. If there is no movement make sure pBarFront is in front of pBarBack.

Jennifer Neighbors OP @Reply

3 years ago

The progress bar is still frozen until I press the Abort button. So, my original issue remains unresolved. I used your code and adjusted some things to fit my situation (for example, my form has a template that supplies some of the variables). Also, it choked on the From, CC, and BCC lines, so I commented them out while focusing on getting the progress bar to work. The front bar MUST be in front of the back bar because it looks perfect after I press ABORT. It sends emails as designed.

Here's the code as it now is:

Private Sub cmdSend_Click()

 Dim FirstName As String, LastName As String, Email As String, Signature As String
 Dim eBody As Variant, ctl As ListBox, varItm As Variant
 Dim lngCounter As Long, X As Integer, lngSelectedCount As Long
 Dim oOutlook As Object

 lngSelectedCount = lstRecipients.ItemsSelected.Count
 If lngSelectedCount = 0 Then
 MsgBox "Please select one or more names from the list.", vbOKOnly, "Information Required"
 Exit Sub
 End If

 On Error GoTo Errorhandler

 If Me.SenderOrganizationNameBold = True Then
 Signature = " " & Me.SenderName & ", " _
 & " " & Me.SenderCompanyOrOrganization & " "
 Else
 Signature = " " & Me.SenderName & ", " _
 & Me.SenderCompanyOrOrganization
 End If

 DoCmd.OpenForm "frmEmailStatus"

 Set oOutlook = CreateObject("Outlook.Application")
 Set ctl = lstRecipients

 lngCounter = 0
 For X = 0 To 100
 For Each varItm In ctl.ItemsSelected
 FirstName = DLookup("FirstName", "tblRecipients", "RecipientID = " & Me.lstRecipients.Column(0, varItm))
 LastName = DLookup("LastName", "tblRecipients", "RecipientID = " & Me.lstRecipients.Column(0, varItm))
 Email = DLookup("EmailAddress", "tblRecipients", "RecipientID = " & Me.lstRecipients.Column(0, varItm))

 eBody = " Dear " & FirstName & " " & LastName & ", " _
 & Me.txtMessage & " " & _
 Signature

 While Not Forms!frmEmailStatus.chkAbort And lngCounter < lngSelectedCount
 With oOutlook.CreateItem(0) 'olMailItem
 .To = Email
' .From = Me.FromEmailAddress
' .CC = Me.CarbonCopyEmailAddress
' .BCC = Me.BlindCarbonCopyEmailAddress
 .Importance = 1 '2 = High
 .Subject = Me.Subject
 .HTMLBody = "<html><body>" & eBody & " <IMG src= '" & PathToLogoImageFile & "' width= 150 align=baseline></body></html>"
 .Send
 End With
 lngCounter = lngCounter + 1
 X = X + (100 / lngSelectedCount)
 MyBar X
 SleepSec (5)
 Wend
 Next varItm
 Next

ErrExit:
 DoCmd.Close acForm, "frmEmailStatus"
 MsgBox lngCounter & " emails sent."
 Set oOutlook = Nothing
 Set ctl = Nothing

 Exit Sub

Errorhandler:
 MsgBox Err.Description, vbExclamation, "Error"
 Resume ErrExit

End Sub

	Jennifer Neighbors OP @Reply 3 years ago
I take it back! It's sending multiple messages to the same person. That indicates to me that there is a problem with the loop. I will take a close look. Thanks

	Jennifer Neighbors OP @Reply 3 years ago
All right. I simply changed the While...Wend to If...Then, as you warned me to do. Now it's sending one message per recipient. Very good! Question: Richard says to place a DoEvents statement inside loops. I noticed you didn't do that. I'm curious about your strategy there. I'm still having an issue with the frozen progress bar. Very frustrating.

	Kevin Robertson @Reply 3 years ago
The reason I didn't use DoEvents throughout the code above is because the is already a DoEvents in the SleepSecs() function.

Jennifer Neighbors OP @Reply

3 years ago

I am still trying to wrap my head around DoEvents. (Yes, I did watch Richard's video. And still...) Thanks for sharing your thoughts, Kevin. I see now that there IS a DoEvents in the loop; it's inside the SleepSec() function. Duh! I very much appreciate your time and patience. If you have any suggestions for getting the progress bar to work, that would be awesome, but if I've I've maxed out your available time, I understand. This has been an epic exchange. I will attribute your contribution to my code in the comments of my Access project. Thank you!

	John Davy @Reply 3 years ago
Hi Jennifer Take a look at Richard's Video Developer 18 Lesson 3. I think it will help John

Jennifer Neighbors OP @Reply

3 years ago

Hi, John - Thanks for the suggestion. I'm not sure I can take Developer lessons. As I understand it, I have to take lessons in order (Beginner first, etc.). Also there is a cost associated with it which I can't currently afford. So, I am starting with the free lessons and going on from there.

This problem with the progress bar has got me really baffled. I followed instructions from the free progress bar video of Richard's so was hoping it would work out... and I'm very close. It looks great once I press the Abort button. The progress is accurately displayed then. It doesn't show any progress before then, even though emails are going out.

	Kevin Robertson @Reply 3 years ago
Are you still setting the Timer Interval (your first screenshot above) in the Status Form. Wondering if that may be causing problems.

	Jennifer Neighbors OP @Reply 3 years ago
No, I removed that. Here is the code now: Option Compare Database Option Explicit Private Sub cmdAbort_Click() Me.chkAbort = True DoEvents End Sub Private Sub Form_Load() Me.chkAbort = False End Sub

	Jennifer Neighbors OP @Reply 3 years ago
If I posted a zip file with my database, would that help someone spot the issue quickly? Is that a thing that is done here? The only difference I see about my progress bar is that it's on a separate form from my loop; otherwise, it is all standard. I am open to suggestions.

This thread is now CLOSED. If you wish to comment, start a NEW discussion in Access Forum.

Next Unseen

New Feature: Comment Live View