Progress Bar Within Code Structure

[JohnLee]

Hi Folks,

I'm hoping someone can help me here, I have the code below that organises tif images into folders, however the problem is that when it's running there is no indicator as to how far along it has got with the process, which causes people to think that it isn't doing anything and has crashed. I would be most grateful if someone could help me put something within this code to show it's progress as it creates and put the tif images into their respective created folders. Here's the Code:

=========
BEGIN CODE
=========

Public Function OrganiseImages()

'This process identifies tif images in the specified path
'groups them together according to their Manufacturer, Batch
'Number and Date into their respective folders and sub folders

Dim FSO As FileSystemObject 'Declare the File System Object
Dim Folder As Folder 'Declare the folder object
Dim SubFolder As Folder 'Declare the sub folder object
Dim File As File 'Declare the File object
Dim SortDate 'Declare the SortDate variable
Dim SortBatch 'Declare the SortBatch variable
Dim ImagePath 'Declare the ImagePath variable

'Set the image path here
ImagePath = "\\prdfs01\images\"

'Set the FSO to new file system object
Set FSO = New FileSystemObject

'If the images folder can't be read, stop running
If Not FSO.FolderExists(ImagePath) Then
'Msgbox to state the folder doesn't exist
MsgBox "Folder Doesn't Exist"
End
End If

'Set the folder object to get the folder and open it
Set Folder = FSO.GetFolder(ImagePath)

'Read each file in images folder
For Each File In Folder.Files
' If file is a tif file then move it
If Right(File.Name, 4) = ".tif" Then
'Assign the date created to the SortDate variable in yyyymmdd format
'1st Mid - Get the year the file was created
'2nd Mid - Get the Month the file was created
'3rd Mid - Get the day the file was created
'Attached the left slash [\] at the end
SortDate = Mid(File.DateCreated, 7, 4) & Mid(File.DateCreated, 4, 2) & Mid(File.DateCreated, 1, 2) & "\"

'Batch destination folder name
SortBatch = Left(File.Name, InStrRev(File.Name, "_") - 1) & "\"

'If the date folder doesn't exist, create it
If Not FSO.FolderExists(ImagePath & SortDate) Then
FSO.CreateFolder (ImagePath & SortDate)
End If

'If the batch folder doesn't exist, create it
If Not FSO.FolderExists(ImagePath & SortDate & SortBatch) Then
FSO.CreateFolder (ImagePath & SortDate & SortBatch)
End If

'Move the file to the folder
File.Move (ImagePath & SortDate & SortBatch)
End If
DoEvents
Next

End Function

=========
END CODE
=========

Cheers

John

 

[namliam]

Did you try the sparkling new search function we have as a novelty ONLY on this forum and no where else on any other forum???

Try this:
http://www.access-programmers.co.uk/forums/showthread.php?t=130802&highlight=Progress+bar

See how far you get.

 

[JohnLee]

Hi namliam,

Thanks for your response, I can't see how I can incorporate this into my code, it also calls up a splash form, which conflicks with my own splash form.

Is there no better way of doing this?

John

 

[DCrake]

Not a progress bar but it lets the user know something is happening is to use the Echo control

Whilst the code is looping through the folders and file names you could enter

Me.Echo = True, Working on: " & ImagePath & SortDate & SortBatch

This will display the details on your status bar.

David

 

[JohnLee]

Hi DCrake,

Thanks for that, I will amend my code accordingly and let you know how it goes.

John

 

[JohnLee]

Hi DCrake,

I amended my code according to your last post, however I get an "Expected End Of Statement" message and it highlights the comma in the "Me.Echo = True," part of your code.

Have I missed something?

John

 

[DCrake]

My mistake it should be

DoCmd.Echo True, StatusBarText

David

 

[JohnLee]

Hi DCrake,

I've amended as per your post, but unfortunately I am still getting the same message! Here's how this section of the code now looks:

===========
BEGIN CODE
===========

'Read each file in images folder
For Each File In Folder.Files
' If file is a tif file then move it
If Right(File.Name, 4) = ".tif" Then
'Assign the date created to the SortDate variable in yyyymmdd format
'1st Mid - Get the year the file was created
'2nd Mid - Get the Month the file was created
'3rd Mid - Get the day the file was created
'Attached the left slash [\] at the end
SortDate = Mid(File.DateCreated, 7, 4) & Mid(File.DateCreated, 4, 2) & Mid(File.DateCreated, 1, 2) & "\"

'Batch destination folder name
SortBatch = Left(File.Name, InStrRev(File.Name, "_") - 1) & "\"

'If the date folder doesn't exist, create it
If Not FSO.FolderExists(ImagePath & SortDate) Then
FSO.CreateFolder (ImagePath & SortDate)
End If

'If the batch folder doesn't exist, create it
If Not FSO.FolderExists(ImagePath & SortDate & SortBatch) Then
FSO.CreateFolder (ImagePath & SortDate & SortBatch)
End If

'Move the file to the folder
File.Move (ImagePath & SortDate & SortBatch)
End If
DoEvents
Me.Echo = True, StatusBarText: "& ImagePath & SortDate & SortBatch
Next

===========
END CODE
===========

The code is in red as shown above and highlights the comma after "= True," part of the code.

The message is "Compile error: expected: end of statement"

Your assistance is appreciated.

John

 

[DCrake]

Me.Echo = True, StatusBarText: "& ImagePath & SortDate & SortBatch

Should read:

DoCmd.Echo True, "Working on :" & ImagePath & " " & SortDate & " " & SortBatch

 

[JohnLee]

Hi DCrake,

Thanks once again, I'll make the amendments and let you know how it goes tomorrow, as the database won't be run until this evening.

John

 

[Thinh]

in general the pseudo code looks something like this
Find the total of records that need to be loop through.


for i = 0 to Total -1
docmd.doEvents
msgbox (i/total)
next

 

[gemma-the-husky]

look at syscmd function to display a progress bar.

however you need to know how many items you are progressing, as the progress bar advances in 5% steps, so you would need to pre-scan all the folders to count the total files before starting the processing