Progress Bar

[parry]

I have the following code that imports data from a number of text files. I wanted to show some sort of progress meter but didnt know how to do it so createda userform with labels that changes to OK after that particular part of the proces has run.

I now want to revisit this and see if I can create a progress bar but dont know where to start. Lat time i tried I got stuck with the bar not doing anything and just holding up the executing of the statements.

Any hints appreciated.

Heres the current code ...

Private Sub cmdImport_Click()
On Error GoTo Err_cmdImport
Dim Path As String, StatusStart As String, Finish As String
Dim FileOffice As String, FileHO As String, FileSales As String, FileMerchant As String, FileChargeback As String
Dim FileCheckStart As String, FileCheckProcess As String, FileCheckEnd As String, FileCheckFailed As String
Dim ImportSalesStart As String, ImportSalesProcess As String
Dim ImportHOStart As String, ImportHOProcess As String
Dim ImportOfficeStart As String, ImportOfficeProcess As String
Dim ImportMerchantStart As String, ImportMerchantProcess As String
Dim TransferSalesStart As String, TransferSalesProcess As String
Dim TransferHOStart As String, TransferHOProcess As String
Dim TransferOfficeStart As String, TransferOfficeProcess As String
Dim TransferMerchantStart As String, TransferMerchantProcess As String
Dim Response As Integer
Dim TimerStart
Dim TimerEnd
Dim TimeTotal

StatusStart = "Import Status:  "
Finish = "OK"

'Check that the merchant extract files exist
Path = "G:MerchantsRisk Analysis"
FileOffice = "merch_risk office.txt"
FileSales = "merch_risk sales.txt"
FileHO = "merch_risk head office.txt"
FileMerchant = "merch_risk.txt"
FileChargeback = "Chargebacks.txt"
FileCheckStart = "a) Check extract files exist"
FileCheckProcess = "Checking merchant extract files exist..."
FileCheckFailed = "File Check Failed!!"

Response = MsgBox("Did you remember to amend the header of the text files?" & Chr(13) & _
"Click Yes if you have, or No to cancel the Import", 260, "Remove Header Info Check")
If Response = 7 Then
MsgBox "OK Dumbass, import process has stopped. Go amend those extract files please"
Exit Sub
End If

'begin timer
TimerStart = Timer


lblStatus.Caption = StatusStart & FileCheckProcess

If Dir(Path & FileOffice) = "" Then
MsgBox "The file " & FileOffice & " does not exist in the folder " & Chr(13) & Path & "." & Chr(13) & _
Chr(13) & "Import process aborted.", vbCritical, "File Does Not Exist!"
lblStatus.Caption = StatusStart & FileCheckFailed
Exit Sub
End If

If Dir(Path & FileSales) = "" Then
MsgBox "The file " & FileSales & " does not exist in the folder " & Chr(13) & Path & "." & Chr(13) & _
Chr(13) & "Import process aborted.", vbCritical, "File Does Not Exist!"
lblStatus.Caption = StatusStart & FileCheckFailed
Exit Sub
End If

If Dir(Path & FileHO) = "" Then
MsgBox "The file " & FileHO & " does not exist in the folder " & Chr(13) & Path & "." & Chr(13) & _
Chr(13) & "Import process aborted.", vbCritical, "File Does Not Exist!"
lblStatus.Caption = StatusStart & FileCheckFailed
Exit Sub
End If

If Dir(Path & FileMerchant) = "" Then
MsgBox "The file " & FileMerchant & " does not exist in the folder " & Chr(13) & Path & "." & Chr(13) & _
Chr(13) & "Import process aborted.", vbCritical, "File Does Not Exist!"
lblStatus.Caption = StatusStart & FileCheckFailed
Exit Sub
End If

If Dir(Path & FileChargeback) = "" Then
MsgBox "The file " & FileChargeback & " does not exist in the folder " & Chr(13) & Path & "." & Chr(13) & _
Chr(13) & "Import process aborted.", vbCritical, "File Does Not Exist!"
lblStatus.Caption = StatusStart & FileCheckFailed
Exit Sub
End If

lblFileCheck.Caption = FileCheckStart & Space(10) & Finish

'Import files into Access
ImportSalesStart = "Import Sales"
ImportHOStart = "Import Head Office"
ImportOfficeStart = "Import Office"
ImportMerchantStart = "Import Merchants"
ImportSalesProcess = "Importing Sales extract file..."
ImportHOProcess = "Importing Head Office extract file..."
ImportOfficeProcess = "Importing Office extract file..."
ImportMerchantProcess = "Importing Merchants extract file..."

lblStatus.Caption = StatusStart & ImportSalesProcess
DoCmd.RunMacro "ImportSales"
DoCmd.RunMacro "ImportChargebacks"
lblSales.Caption = ImportSalesStart & Space(26 - Len(ImportSalesStart)) & Finish

lblStatus.Caption = StatusStart & ImportHOProcess
DoCmd.RunMacro "ImportHeadOffice"
lblHeadOffice.Caption = ImportHOStart & Space(22 - Len(ImportHOStart)) & Finish

lblStatus.Caption = StatusStart & ImportOfficeProcess
DoCmd.RunMacro "ImportOffice"
lblOffice.Caption = ImportOfficeStart & Space(27 - Len(ImportOfficeStart)) & Finish

lblStatus.Caption = StatusStart & ImportMerchantProcess
DoCmd.RunMacro "ImportMerchant"
lblMerchants.Caption = ImportMerchantStart & Space(20 - Len(ImportOfficeStart)) & Finish

'Transfer files from Import tables into main tables
TransferSalesStart = "Transfer Sales"
TransferSalesProcess = "Transfering Sales table data..."
TransferHOStart = "Transfer Head Office"
TransferHOProcess = "Transfering Head Office table data..."
TransferOfficeStart = "Transfer Office"
TransferOfficeProcess = "Transfering Office table data..."
TransferMerchantStart = "Transfer Merchants"
TransferMerchantProcess = "Transfering Merchant table data..."

lblStatus.Caption = StatusStart & TransferSalesProcess
DoCmd.RunMacro "TransferSales"
lblTSales.Caption = TransferSalesStart & Space(26 - Len(TransferSalesStart)) & Finish

lblStatus.Caption = StatusStart & TransferHOProcess
DoCmd.RunMacro "TransferHeadOffice"
lblTHeadOffice.Caption = TransferHOStart & Space(26 - Len(TransferHOStart)) & Finish

lblStatus.Caption = StatusStart & TransferOfficeProcess
DoCmd.RunMacro "TransferOffice"
lblTOffice.Caption = TransferOfficeStart & Space(26 - Len(TransferOfficeStart)) & Finish

lblStatus.Caption = StatusStart & TransferMerchantProcess
DoCmd.RunMacro "TransferMerchant"
lblTMerchant.Caption = TransferMerchantStart & Space(26 - Len(TransferMerchantStart)) & Finish

'end timer
TimerEnd = Timer
TimeTotal = TimerEnd - TimerStart
MsgBox "Import successfully completed !!" & Chr(13) & "The import process took " & TimeTotal & " seconds", _
vbOKOnly, "You da man!"
Exit Sub

Err_cmdImport:
MsgBox "An error has occured. Error Number: " & Err.Number & "Description :" & Err.Description
Exit Sub

End Sub

 

[smozgur]

Parry,

Sorry, I can't test your code but I can say that you should use;

Me.Repaint

after each changing lblStatus.Caption.


I hope it helps.
Suat