vba - Providing status updates for macro that goes into not responding state until completion -

i have vba macro search through email archives.

when searching through tens of thousands of emails, (or couple hundred on test machine) displays status few seconds, enters not responding state while running through rest of emails.

this has led impatient users close out of task prematurely, , rectify providing status updates.

i have coded following solution, , believe problem lies in way garbagecollector functions in vba during loop.

public sub searchandmove()      userform1.show      ' send message user indicating     ' program has completed successfully,      ' , displaying number of messages sent during run.  end sub  private sub userform_activate()  me.width = 240 me.height = 60  me.label1.width = 230 me.label1.height = 50  dim oselecttarget outlook.folder dim omovetarget outlook.folder dim osearchcriteria string  ' select target folder search , folder ' files should moved set oselecttarget = application.session.pickfolder set omovetarget = application.session.pickfolder  osearchcriteria = inputbox("input search string: ")  dim selecteditems outlook.items set selecteditems = oselecttarget.items dim selectedemail outlook.mailitem  dim statusbarmsg string statusbarmsg = ""  dim initialcount long initialcount = selecteditems.count   dim movedcounter long movedcounter = 0 dim x long dim exists long  ' function loop, stepping backwards ' prevent errors derived modifying collection x = selecteditems.count 1 step -1     set selectedemail = selecteditems.item(x)     ' test determine if subject contains search string      exists = instr(selectedemail.subject, osearchcriteria)     if len(selectedemail.subject) > 999         selectedemail.move omovetarget     else:         if exists <> 0             selectedemail.move omovetarget             movedcounter = (movedcounter + 1)         else: end if     end if     set selectedemail = nothing     statusbarmsg = "processing " & x & " out of " & initialcount & " messages."      userform1.label1.caption = statusbarmsg     userform1.repaint next x  dim msg string dim response msg = "searchandmove has detected , moved " & movedcounter & _   " messages since last run." response = msgbox(msg, vbokonly)   ' close references prevent reference leak set oselecttarget = nothing set omovetarget = nothing set selecteditems = nothing set selectedemail = nothing  unload me  end sub 

change line

userform1.repaint

to

doevents

yes increase execution time in case there thousands of emails don't have of option.

tip: might want change

statusbarmsg = "processing " & x & " out of " & initialcount & " messages."

to

statusbarmsg = "please not interrupt. processing " & x & " out of " & initialcount & " messages."

also advisable inform user @ beginning of process might take time , hence can run process when sure not want work on pc?

something this

sub sample()     dim strwarning string     dim ret      strwarning = "this process may take sometime. advisable run " & _     "when don't intend use pc sometime. continue?"      ret = msgbox(strwarning, vbyesno, "information")      if ret <> vbyes exit sub      x = selecteditems.count 1 step -1      '~~> rest of code end sub 

hth

sid