Sleekmac
Registered User.
- Local time
- Today, 03:31
- Joined
- Sep 25, 2006
- Messages
- 34
Hi again all! Before I ask my question let me just say you folks have always been kind and helpful, and I appreciate your time. I did search this site and several others via google and I found some progressbar code that I Frankensteined onto my own Access project. It works...the problem is the user can't see the stupid thing until it's finished.
This is the way I have it set up:
I have a form called Progress, it is non-modal + non-popup, and has just two objects on it, Label1 and Label2.
Under MS Access Class Objects>Form_Progress:
*Note - I also tried this on the Form_Open and Form_Load events with the same negative result.
Private Sub Form_Activate()
Me.Label1.Height = 600
Me.Label1.Caption = "0% Complete"
Me.Label1.Width = 0
Me.Label1.BackColor = wdColorBlue
Me.Label2.Caption = "Checking Directories"
Me.Repaint
DoEvents
DoCmd.SetWarnings False
Call ListFiles
DoCmd.SetWarnings True
End Sub
This obviously is triggered whenever the Progress Form is opened, which I have it set to do on Startup. The procedures on App startup include identifying all files in all subdirectories of a given directory, inserting them into a Temp Table (temptable2) as records, then comparing temptable2 to temptable (the temp table from the last time the procedure was run). For any files that are there now that were not there last time, a function is called that will import several fields from the target excel files and insert that data into a data table table as a new record. For files that were there before, but the saved FileDateTime is prior to the current FileDateTime, another function is called that will update the records with the data that has changed.This is all triggered by my main function, Listfiles().
There are 5 main steps and I've worked out how I want to increment the progressbar. Listfiles() calls the function Increment() at these 5 points and increments the bar by preset %s. For example, step 1 is search the directory and append any new datafiles, that's 20% of the overall task. 2 is to count and identify the new files, that's 10%...3 is to import new records into my data table (not the temp table), that's 30%, 4 is check files that were there before but they have been modified since then (10%), and 5 is update the records in the data table with the new data from the modified source (30%). So what I am trying to say is, after each of those steps, I call the function Increment() and it has 3 arguments...the first is the % complete, the second is the text message (eg. "Searching Directories..."), and the third is the distance I want the box to increase.
Here is the function that increments the bar:
Function Increment(sPercentComplete As Single, _
sDescription As String, sInterval As Double)
'update label1 with % done, label2 with message, Expand label1 horizontally
On Error Resume Next
Dim iPercentIncrement As Integer, curWid As Double
iPercentIncrement = Format(sPercentComplete, "#")
curWid = Forms!progress.Label1.Width
curWid = curWid + sInterval
Forms!progress.Label1.Width = Format(curWid, "#.##")
Forms!progress.Label1.Caption = sPercentComplete & "%"
Forms!progress.Label2.Caption = sDescription
Forms!progress.Repaint
DoEvents
End Function
And here is the main function that calls it:
*Note that the functions that append and update real data records have been commented out during testing.
Function ListFiles()
Dim varFoundFile As Variant
Dim lngFile As Long
Dim conn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim mySQL As String, fDate As Date, obj As Object
Dim interval As Double, i As Integer, x As Integer
Set conn = CurrentProject.Connection
rs.activeconnection = conn
DoCmd.RunSQL "DELETE [TempTable2].* FROM [TempTable2]" 'clear temp2
With Application.FileSearch
.FileName = "*" 'will change to *.xls post-test
.SearchSubFolders = True
.LookIn = "C:\Documents and Settings\rhodedf\My Documents\"
.Execute
For Each varFoundFile In .FoundFiles
lngFile = lngFile + 1
fDate = FileDateTime(varFoundFile)
mySQL = "INSERT INTO TempTable2 (SourceName, FileDate) SELECT '" & varFoundFile & "', #" & fDate & "#"
DoCmd.RunSQL mySQL 'load all files found into temp2
Next varFoundFile
.NewSearch
End With
Call Increment(20, "Tallying new Files", 800)
mySQL = "SELECT COUNT([TempTable2 Without Matching Temp Table].SourceName) AS CountOfSourceName FROM [TempTable2 Without Matching Temp Table]"
rs.Open mySQL
rs.MoveFirst
If rs.Fields("countofsourcename") > 0 Then
interval = 900 / rs.Fields("countofsourcename")
Call Increment(30, rs.Fields("countofsourcename") & " new files found.", 400)
rs.Close
mySQL = "SELECT * FROM [TempTable2 Without Matching Temp Table]"
rs.Open mySQL
rs.MoveFirst
i = 1
While Not rs.EOF
'entryProp (rs.Fields("sourcename"))
DoCmd.RunSQL "INSERT INTO TempTable (SourceName, FileDate) SELECT '" & rs.Fields("sourcename") & "', #" & rs.Fields("filedate") & "#"
Call Increment(30 + (interval * i), "Importing file #" & i, interval)
rs.MoveNext
i = i + 1
Wend
rs.Close
Else
Call Increment(60, "No new files found.", 1200)
rs.Close
End If
Call Increment(100, "Done", 3200)
mySQL = "SELECT * FROM [ChangesMade]"
rs.Open mySQL
If rs.RecordCount > 0 Then
rs.MoveFirst
While Not rs.EOF
'editProp(rs.fields("sourcename")
rs.MoveNext
Wend
End If
Set conn = Nothing
End Function
Like I said, everything works. I know this because I have forced the code to stop at all steps and when I do, the form pops up with the current data. But if I run it like a user would, the action all takes place in the background and then the form pops up with 100% and a full bar. Not very useful. I've tried sprinkling DoEvents lines throughout the code and it has no effect.
Am I missing something obvious here? Any help you could provide would be very much appreciated!
Thanks,
Don
This is the way I have it set up:
I have a form called Progress, it is non-modal + non-popup, and has just two objects on it, Label1 and Label2.
Under MS Access Class Objects>Form_Progress:
*Note - I also tried this on the Form_Open and Form_Load events with the same negative result.
Private Sub Form_Activate()
Me.Label1.Height = 600
Me.Label1.Caption = "0% Complete"
Me.Label1.Width = 0
Me.Label1.BackColor = wdColorBlue
Me.Label2.Caption = "Checking Directories"
Me.Repaint
DoEvents
DoCmd.SetWarnings False
Call ListFiles
DoCmd.SetWarnings True
End Sub
This obviously is triggered whenever the Progress Form is opened, which I have it set to do on Startup. The procedures on App startup include identifying all files in all subdirectories of a given directory, inserting them into a Temp Table (temptable2) as records, then comparing temptable2 to temptable (the temp table from the last time the procedure was run). For any files that are there now that were not there last time, a function is called that will import several fields from the target excel files and insert that data into a data table table as a new record. For files that were there before, but the saved FileDateTime is prior to the current FileDateTime, another function is called that will update the records with the data that has changed.This is all triggered by my main function, Listfiles().
There are 5 main steps and I've worked out how I want to increment the progressbar. Listfiles() calls the function Increment() at these 5 points and increments the bar by preset %s. For example, step 1 is search the directory and append any new datafiles, that's 20% of the overall task. 2 is to count and identify the new files, that's 10%...3 is to import new records into my data table (not the temp table), that's 30%, 4 is check files that were there before but they have been modified since then (10%), and 5 is update the records in the data table with the new data from the modified source (30%). So what I am trying to say is, after each of those steps, I call the function Increment() and it has 3 arguments...the first is the % complete, the second is the text message (eg. "Searching Directories..."), and the third is the distance I want the box to increase.
Here is the function that increments the bar:
Function Increment(sPercentComplete As Single, _
sDescription As String, sInterval As Double)
'update label1 with % done, label2 with message, Expand label1 horizontally
On Error Resume Next
Dim iPercentIncrement As Integer, curWid As Double
iPercentIncrement = Format(sPercentComplete, "#")
curWid = Forms!progress.Label1.Width
curWid = curWid + sInterval
Forms!progress.Label1.Width = Format(curWid, "#.##")
Forms!progress.Label1.Caption = sPercentComplete & "%"
Forms!progress.Label2.Caption = sDescription
Forms!progress.Repaint
DoEvents
End Function
And here is the main function that calls it:
*Note that the functions that append and update real data records have been commented out during testing.
Function ListFiles()
Dim varFoundFile As Variant
Dim lngFile As Long
Dim conn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim mySQL As String, fDate As Date, obj As Object
Dim interval As Double, i As Integer, x As Integer
Set conn = CurrentProject.Connection
rs.activeconnection = conn
DoCmd.RunSQL "DELETE [TempTable2].* FROM [TempTable2]" 'clear temp2
With Application.FileSearch
.FileName = "*" 'will change to *.xls post-test
.SearchSubFolders = True
.LookIn = "C:\Documents and Settings\rhodedf\My Documents\"
.Execute
For Each varFoundFile In .FoundFiles
lngFile = lngFile + 1
fDate = FileDateTime(varFoundFile)
mySQL = "INSERT INTO TempTable2 (SourceName, FileDate) SELECT '" & varFoundFile & "', #" & fDate & "#"
DoCmd.RunSQL mySQL 'load all files found into temp2
Next varFoundFile
.NewSearch
End With
Call Increment(20, "Tallying new Files", 800)
mySQL = "SELECT COUNT([TempTable2 Without Matching Temp Table].SourceName) AS CountOfSourceName FROM [TempTable2 Without Matching Temp Table]"
rs.Open mySQL
rs.MoveFirst
If rs.Fields("countofsourcename") > 0 Then
interval = 900 / rs.Fields("countofsourcename")
Call Increment(30, rs.Fields("countofsourcename") & " new files found.", 400)
rs.Close
mySQL = "SELECT * FROM [TempTable2 Without Matching Temp Table]"
rs.Open mySQL
rs.MoveFirst
i = 1
While Not rs.EOF
'entryProp (rs.Fields("sourcename"))
DoCmd.RunSQL "INSERT INTO TempTable (SourceName, FileDate) SELECT '" & rs.Fields("sourcename") & "', #" & rs.Fields("filedate") & "#"
Call Increment(30 + (interval * i), "Importing file #" & i, interval)
rs.MoveNext
i = i + 1
Wend
rs.Close
Else
Call Increment(60, "No new files found.", 1200)
rs.Close
End If
Call Increment(100, "Done", 3200)
mySQL = "SELECT * FROM [ChangesMade]"
rs.Open mySQL
If rs.RecordCount > 0 Then
rs.MoveFirst
While Not rs.EOF
'editProp(rs.fields("sourcename")
rs.MoveNext
Wend
End If
Set conn = Nothing
End Function
Like I said, everything works. I know this because I have forced the code to stop at all steps and when I do, the form pops up with the current data. But if I run it like a user would, the action all takes place in the background and then the form pops up with 100% and a full bar. Not very useful. I've tried sprinkling DoEvents lines throughout the code and it has no effect.
Am I missing something obvious here? Any help you could provide would be very much appreciated!
Thanks,
Don
Last edited:
