Hi All,
Hopefully someone might be able to help me here, I've searched the forum and haven't found anything covering the creation of a progress bar.
I have a module that is actioned when a macro is triggered via a button on a form.
The problem I have is that when ever the module runs, apart from the view at the bottom of the screen, there is nothing to show clearly that the program is running.
What I would like to be able to do is create a progress bar that sits centrally on screen showing clearly to the end user that something is happening.
Below is the code in my module, which carries out a number of actions from importing data to triggering queries to printing reports etc.
Any assistance on how to include a progress bar within this code would be most appreciated.
=================
START CODE
=================
Option Compare Database
'------------------------------------------------------------
' mcrDDMandateImport
'
'------------------------------------------------------------
Function mcrDDMandateImport()
On Error Resume Next
DoCmd.Echo False, "Running ADD.LP Program"
DoCmd.Hourglass True 'Turn on the Hour Glass
DoCmd.SetWarnings False 'Turn Off the Warnings
'Sets the FS variable to the CreateObject
Set FS = CreateObject("Scripting.FileSystemObject")
'Checks to see if the REJ.txt file exists if it does't then
'the process ends, if it does then it runs the 1st phase of
'the process
If FS.FileExists("C:\JohnLeeBackupInformation\ADDLPImport.txt") = False Then
MsgBox "File Does Not Exist"
Else
'Import the data from the text file ADDLPImport.txt.
DoCmd.TransferText acImportFixed, "ADDLPImportSpec", "tblDDMandateImport", "C:\JohnLeeBackupInformation\ADDLPImport.txt", False, ""
End If
'Append DGI data from the tblDDMandateImport table to the tblLetterRunDGI table
DoCmd.OpenQuery "qryAppDDMandateDGI", acNormal, acEdit
'Append DGS data from the tblDDMandateImport Table to the tblLetterRunDGS Table
DoCmd.OpenQuery "qryAppDDMandateDGS", acNormal, acEdit
'Append Sky data from the tblDDMandateImport Table to the tblLetterRunSky table
DoCmd.OpenQuery "qryAppDDMandateSky", acNormal, acEdit
'Append data with No address details from the tblDDMandateImport table to the tblNoAddress table
DoCmd.OpenQuery "qryAppNoAddress", acNormal, acEdit
'Append DGI non DD data from the tblDDMandateImport Table to the tblLetterRunDGI2 table
DoCmd.OpenQuery "qryAppDDMandateDGI2", acNormal, acEdit
'Append DGS non DD data from the tblDDMandateImport Table to the tblLetterRunDGS2 table
DoCmd.OpenQuery "qryAppDDMandateDGS2", acNormal, acEdit
'Append Sky non DD data from the tblDDMandateImport Table to the tblLetterRunSky2 table
DoCmd.OpenQuery "qryAppDDMandateSky2", acNormal, acEdit
'Append the data from the tblDGI2_NoPostCode table to the tbltblDGI2_NoPostCode table
DoCmd.OpenQuery "qryAppDGI2_NoPostCode", acNormal, acEdit
'Append the data from the tblDGI_NoPostCode table to the tblDGI_NoPostCode table
DoCmd.OpenQuery "qryAppDGI_NoPostCode", acNormal, acEdit
'Append the data from the tblDGS2_NoPostCode table to the tblDGS2_NoPostCode table
DoCmd.OpenQuery "qryAppDGS2_NoPostCode", acNormal, acEdit
'Append the data from the tblDGS_NoPostCode table to the tblDGS_NoPostCode table
DoCmd.OpenQuery "qryAppDGS_NoPostCode", acNormal, acEdit
'Append the data from the tblSky2_NoPostCode table to the tblSky2_NoPostCode table
DoCmd.OpenQuery "qryAppSky2_NoPostCode", acNormal, acEdit
'Append the data from the tblSky_NoPostCode table to the tblSky_NoPostCode table
DoCmd.OpenQuery "qryAppSky_NoPostCode", acNormal, acEdit
'Append stats data from tblDDMandateImportDGI table to tblDDMandateStatsDGI
DoCmd.OpenQuery "qryAppDDMandateImportStatsDGI", acNormal, acEdit
'Append stats data from tblDDMandateImportDGS table to tblDDMandateStatsDGS
DoCmd.OpenQuery "qryAppDDMandateImportStatsDGS", acNormal, acEdit
'Append stats data from tblDDMandateImportSky table to tblDDMandateStatsSky
DoCmd.OpenQuery "qryAppDDMandateImportStatsSky", acNormal, acEdit
'Append stats data from tblDDMandateImport table to tblDDMandateStats
DoCmd.OpenQuery "qryAppDDMandateImportStatsYear", acNormal, acEdit
'Append stats data from tblDDMandateImport to tblREJ6StatsDGI table
DoCmd.OpenQuery "qryAppDDMandateImportStatsREJ6DGI", acNormal, acEdit
'Append stats data from tblDDMandateImport to tblREJ6StatsDGS table
DoCmd.OpenQuery "qryAppDDMandateImportStatsREJ6DGS", acNormal, acEdit
'Append stats data from tblDDMandateImport to tblREJ6StatsSky table
DoCmd.OpenQuery "qryAppDDMandateImportStatsREJ6Sky", acNormal, acEdit
'Append the data from the tblDGI2_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppDGI2_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblDGI_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppDGI_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblDGS2_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppDGS2_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblDGS_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppDGS_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblSky2_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppSky2_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblSky_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppSky_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblDGI2_NoPostCode table to the tblLetterRunDGI2 table
DoCmd.OpenQuery "qryAppDGI2_NoPostCodeTotblLetterRunDGI2", acNormal, acEdit
'Append the data from the tblDGI_NoPostCode table to the tblLetterRunDGI table
DoCmd.OpenQuery "qryAppDGI_NoPostCodeTotblLetterRunDGI", acNormal, acEdit
'Append the data from the tblDGS2_NoPostCode table to the tblLetterRunDGS2 table
DoCmd.OpenQuery "qryAppDGS2_NoPostCodeTotblLetterRunDGS2", acNormal, acEdit
'Append the data from the tblDGS_NoPostCode table to the tblLetterRunDGS table
DoCmd.OpenQuery "qryAppDGS_NoPostCodeTotblLetterRunDGS", acNormal, acEdit
'Append the data from the tblSky2_NoPostCode table to the tblLetterRunSky2 table
DoCmd.OpenQuery "qryAppSky2_NoPostCodeTotblLetterRunSky2", acNormal, acEdit
'Append the data from the tblSky_NoPostCode table to the tblLetterRunSky table
DoCmd.OpenQuery "qryAppSky_NoPostCodeTotblLetterRunSky", acNormal, acEdit
'Appends the data from the tblNoAddress table to the tblNoAddressStats table
DoCmd.OpenQuery "qryApptblNoAddressTotblNoAddressStats", acNormal, acEdit
'Appends the data from the tblDGI2_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblDGI2_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblDGI_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblDGI_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblDGS2_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblDGS2_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblDGS_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblDGS_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblSky2_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblSky2_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblSky_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblSky_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblNoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryApptblNoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append data with the Letter Code "REJ6" to the tblREJ6DGI table
DoCmd.OpenQuery "qryAppREJ6LetterCodeTotblREJ6DGI", acNormal, acEdit
'Append data with the Letter Code "REJ6" to the tblREJ6DGS table
DoCmd.OpenQuery "qryAppREJ6LetterCodeTotblREJ6DGS", acNormal, acEdit
'Append data with the Letter Code "REJ6" to the tblREJ6Sky table
DoCmd.OpenQuery "qryAppREJ6LetterCodeTotblREJ6Sky", acNormal, acEdit
'Print DGI Seperator Page
DoCmd.OpenReport "rptDGI_Seperator", acNormal, "", ""
'Print the DGI rptDDLetterRun report
DoCmd.OpenReport "rptDDLetterRunDGI", acNormal, "", ""
'Print DGS Seperator Page
DoCmd.OpenReport "rptDGS_Seperator", acNormal, "", ""
'Print the DGS rptDDLetterRun report
DoCmd.OpenReport "rptDDLetterRunDGS", acNormal, "", ""
'Print Sky Seperator Page
DoCmd.OpenReport "rptSky_Seperator", acNormal, "", ""
'Print the Sky rptDDLetterRun report
DoCmd.OpenReport "rptDDLetterRunSky", acNormal, "", ""
'If the tables tblLetterRunDGI2, tblLetterRunDGS2 or tblLetterRunSky2 have records in them then
If DCount("*", "tblLetterRunDGI2") > 0 And DCount("*", "tblLetterRunDGS2") > 0 _
And DCount("*", "tblLetterRunSky2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the tables tblLetterRunDGI2 and tblLetterRunDGS2 have records in them then
If DCount("*", "tblLetterRunDGI2") > 0 And DCount("*", "tblLetterRunDGS2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the tables tblLetterRunDGI2 and tblLetterRunSky2 have records in them then
If DCount("*", "tblLetterRunDGI2") > 0 And DCount("*", "tblLetterRunSky2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the tables tblLetterRunDGS2 and tblLetterRunSky2 have records in them then
If DCount("*", "tblLetterRunDGS2") > 0 And DCount("*", "tblLetterRunSky2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the table tblLetterRunDGI2 has records in it then
If DCount("*", "tblLetterRunDGI2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the table tblLetterRunDGS2 has records in it then
If DCount("*", "tblLetterRunDGS2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the table tblLetterRunSky2 has records in it then
If DCount("*", "tblLetterRunSky2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
End If
End If
End If
End If
End If
End If
End If
'If the tblLetterRunDGI table has records in it then
If DCount("*", "tblLetterRunDGI2") > 0 Then
'Print the DGI rptLetterRun Report
DoCmd.OpenReport "rptLetterRunDGI", acNormal, "", ""
End If
'If the tblLetterRunDGS table has records in it then
If DCount("*", "tblLetterRunDGS2") > 0 Then
'Print the DGS rptLetterRun Report
DoCmd.OpenReport "rptLetterRunDGS", acNormal, "", ""
End If
'If the tblLetterRunSky table has records in it then
If DCount("*", "tblLetterRunSky2") > 0 Then
'Print the Sky rptLetterRun Report
DoCmd.OpenReport "rptLetterRunSky", acNormal, "", ""
End If
'Print the rptDailyLetterCount report
DoCmd.OpenReport "rptDailyLetterCount", acNormal, "", ""
'If the tblREJ6DGI table has records in it then
If DCount("*", "tblREJ6DGI") > 0 Then
'Print the rptREJ6ListingDGI
DoCmd.OpenReport "rptREJ6ListingDGI", acNormal, "", ""
End If
'If the tblREJ6DGS table has records in it then
If DCount("*", "tblREJ6DGS") > 0 Then
'Print the rptREJ6ListingDGS
DoCmd.OpenReport "rptREJ6ListingDGS", acNormal, "", ""
End If
'If the tblREJ6Sky table has records in it then
If DCount("*", "tblREJ6Sky") > 0 Then
'Print the rptREJ6ListingSky
DoCmd.OpenReport "rptREJ6ListingSky", acNormal, "", ""
End If
'If the tblNoAddress table has records in it then
If DCount("*", "tblNoAddress") > 0 Then
'Print the rptNoAddress report
DoCmd.OpenReport "rptNoAddress", acNormal, "", ""
End If
'If the tblNoPostCode table has records in it then
If DCount("*", "tblNoPostCode") > 0 Then
'Print the rptNoAddress report
DoCmd.OpenReport "rptNoPostCode", acNormal, "", ""
End If
'Append the data from the tblDDMandateImport table to the tblDDMandateImportHistory table
DoCmd.OpenQuery "qryAppDDMandateImportToDDMandateHistory", acNormal, acEdit
Dim dtmDate 'Declare dtmDate variable
Dim CurrentDay 'Declare CurrentDay variable
CurrentDay = Format(Now(), "dd/mm/yy")
Call LastWorkDay 'Call the LastWorkDay Function
LastWorkDayOfMonth = LastWorkDay 'Assign the value of LastWorkDay to the LastWorkDayOfMonth variable
'If the current date ie equal to the LastWork Day Of The Month then
If CurrentDay = LastWorkDayOfMonth Then
'Print the Montly Letter Type Chart
DoCmd.OpenReport "rptChartMonthlyLetterCount", acNormal, "", ""
End If
'Delete the contents of the tblDDMandateImport table
DoCmd.OpenQuery "qryDelDDMandateImport", acNormal, acEdit
'Delete the contents of the tblLetterRunDGI table
DoCmd.OpenQuery "qryDelLetterRunDGI", acNormal, acEdit
'Delete the contents of the tblLetterRunDGS table
DoCmd.OpenQuery "qryDelLetterRunDGS", acNormal, acEdit
'Delete the contents of the tblLetterRunSky table
DoCmd.OpenQuery "qryDelLetterRunSky", acNormal, acEdit
'Delete the contents of the tblREJ6DGI table
DoCmd.OpenQuery "qryDeltblREJ6DGI", acNormal, acEdit
'Delete the contents of the tblREJ6DGS table
DoCmd.OpenQuery "qryDeltblREJ6DGS", acNormal, acEdit
'Delete the contents of the tblREJ6Sky table
DoCmd.OpenQuery "qryDeltblREJ6Sky", acNormal, acEdit
'Delete the Contents of the tblLetterRunDGI2 table
DoCmd.OpenQuery "qryDelLetterRunDGI2", acNormal, acEdit
'Delete the Contents of the tblLetterRunDGS2 table
DoCmd.OpenQuery "qryDelLetterRunDGS2", acNormal, acEdit
'Delete the Contents of the tblLetterRunSky2 table
DoCmd.OpenQuery "qryDelLetterRunSky2", acNormal, acEdit
'Delete the contents of the tblDGI2_NoPostCode table
DoCmd.OpenQuery "qryDeltblDGI2_NoPostCode", acNormal, acEdit
'Delete the contents of the tblDGI_NoPostCode table
DoCmd.OpenQuery "qryDeltblDGI_NoPostCode", acNormal, acEdit
'Delete the contents of the tblDGS2_NoPostCode table
DoCmd.OpenQuery "qryDeltblDGS2_NoPostCode", acNormal, acEdit
'Delete the contents of the tblDGS_NoPostCode table
DoCmd.OpenQuery "qryDeltblDGS_NoPostCode", acNormal, acEdit
'Delete the contents of the tblSky2_NoPostCode table
DoCmd.OpenQuery "qryDeltblSky2_NoPostCode", acNormal, acEdit
'Delete the contents of the tblSky_NoPostCode table
DoCmd.OpenQuery "qryDeltblSky_NoPostCode", acNormal, acEdit
'Delete the contents of the tblNoAddress table
DoCmd.OpenQuery "qryDeltblNoAddress", acNormal, acEdit
'Delete the contents of the tblNoPostCode table
DoCmd.OpenQuery "qryDeltblNoPostCode", acNormal, acEdit
'Export the tblDDMandateImport table to the E Drive Test Data Folder and replace the existing ADDLPImport.txt file
DoCmd.TransferText acExportFixed, "ADDLPImportSpec", "tblDDMandateImport", "C:\JohnLeeBackupInformation\ADDLPImport.txt", False, ""
'Backup Process - Copy the tables listed below to the backup Database ADDLP BU.mdb
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblCompanyTypes", "tblCompanyTypes", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblDDMadateStats", "tblDDMadateStats", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblDDMandateImportHistory", "tblDDMandateImportHistory", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblDDMandateStatsDGI", "tblDDMandateStatsDGI", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblDDMandateStatsDGS", "tblDDMandateStatsDGS", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblDDMandateStatsSky", "tblDDMandateStatsSky", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblLetterTypeCode", "tblLetterTypeCode", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblREJ6StatsDGI", "tblREJ6StatsDGI", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblREJ6StatsDGS", "tblREJ6StatsDGS", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblREJ6StatsSky", "tblREJ6StatsSky", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblNoAddressStats", "tblNoAddressStats", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblNoNoPostCodeStats", "tblNoPostCodeStats", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblUserID", "tblUserID", False
Dim TextString3 'Declares the TextString3 variable
TextString3 = "DIRECT DEBIT LETTER " & vbCr
TextString3 = TestString3 & "AND BACKUP PROCESS COMPLETED"
'Outputs the contents of the TextString3 as an on screen message
MsgBox TextString3, vbInformation, "DIRECT DEBIT LETTER AND BACKUP PROCESS"
DoCmd.Echo True, ""
DoCmd.Hourglass False 'Turn Off the Hour Glass
DoCmd.SetWarnings True 'Turn on the Warnings
End Function
====================
END CODE
====================
Thanks in advance.
John
Hopefully someone might be able to help me here, I've searched the forum and haven't found anything covering the creation of a progress bar.
I have a module that is actioned when a macro is triggered via a button on a form.
The problem I have is that when ever the module runs, apart from the view at the bottom of the screen, there is nothing to show clearly that the program is running.
What I would like to be able to do is create a progress bar that sits centrally on screen showing clearly to the end user that something is happening.
Below is the code in my module, which carries out a number of actions from importing data to triggering queries to printing reports etc.
Any assistance on how to include a progress bar within this code would be most appreciated.
=================
START CODE
=================
Option Compare Database
'------------------------------------------------------------
' mcrDDMandateImport
'
'------------------------------------------------------------
Function mcrDDMandateImport()
On Error Resume Next
DoCmd.Echo False, "Running ADD.LP Program"
DoCmd.Hourglass True 'Turn on the Hour Glass
DoCmd.SetWarnings False 'Turn Off the Warnings
'Sets the FS variable to the CreateObject
Set FS = CreateObject("Scripting.FileSystemObject")
'Checks to see if the REJ.txt file exists if it does't then
'the process ends, if it does then it runs the 1st phase of
'the process
If FS.FileExists("C:\JohnLeeBackupInformation\ADDLPImport.txt") = False Then
MsgBox "File Does Not Exist"
Else
'Import the data from the text file ADDLPImport.txt.
DoCmd.TransferText acImportFixed, "ADDLPImportSpec", "tblDDMandateImport", "C:\JohnLeeBackupInformation\ADDLPImport.txt", False, ""
End If
'Append DGI data from the tblDDMandateImport table to the tblLetterRunDGI table
DoCmd.OpenQuery "qryAppDDMandateDGI", acNormal, acEdit
'Append DGS data from the tblDDMandateImport Table to the tblLetterRunDGS Table
DoCmd.OpenQuery "qryAppDDMandateDGS", acNormal, acEdit
'Append Sky data from the tblDDMandateImport Table to the tblLetterRunSky table
DoCmd.OpenQuery "qryAppDDMandateSky", acNormal, acEdit
'Append data with No address details from the tblDDMandateImport table to the tblNoAddress table
DoCmd.OpenQuery "qryAppNoAddress", acNormal, acEdit
'Append DGI non DD data from the tblDDMandateImport Table to the tblLetterRunDGI2 table
DoCmd.OpenQuery "qryAppDDMandateDGI2", acNormal, acEdit
'Append DGS non DD data from the tblDDMandateImport Table to the tblLetterRunDGS2 table
DoCmd.OpenQuery "qryAppDDMandateDGS2", acNormal, acEdit
'Append Sky non DD data from the tblDDMandateImport Table to the tblLetterRunSky2 table
DoCmd.OpenQuery "qryAppDDMandateSky2", acNormal, acEdit
'Append the data from the tblDGI2_NoPostCode table to the tbltblDGI2_NoPostCode table
DoCmd.OpenQuery "qryAppDGI2_NoPostCode", acNormal, acEdit
'Append the data from the tblDGI_NoPostCode table to the tblDGI_NoPostCode table
DoCmd.OpenQuery "qryAppDGI_NoPostCode", acNormal, acEdit
'Append the data from the tblDGS2_NoPostCode table to the tblDGS2_NoPostCode table
DoCmd.OpenQuery "qryAppDGS2_NoPostCode", acNormal, acEdit
'Append the data from the tblDGS_NoPostCode table to the tblDGS_NoPostCode table
DoCmd.OpenQuery "qryAppDGS_NoPostCode", acNormal, acEdit
'Append the data from the tblSky2_NoPostCode table to the tblSky2_NoPostCode table
DoCmd.OpenQuery "qryAppSky2_NoPostCode", acNormal, acEdit
'Append the data from the tblSky_NoPostCode table to the tblSky_NoPostCode table
DoCmd.OpenQuery "qryAppSky_NoPostCode", acNormal, acEdit
'Append stats data from tblDDMandateImportDGI table to tblDDMandateStatsDGI
DoCmd.OpenQuery "qryAppDDMandateImportStatsDGI", acNormal, acEdit
'Append stats data from tblDDMandateImportDGS table to tblDDMandateStatsDGS
DoCmd.OpenQuery "qryAppDDMandateImportStatsDGS", acNormal, acEdit
'Append stats data from tblDDMandateImportSky table to tblDDMandateStatsSky
DoCmd.OpenQuery "qryAppDDMandateImportStatsSky", acNormal, acEdit
'Append stats data from tblDDMandateImport table to tblDDMandateStats
DoCmd.OpenQuery "qryAppDDMandateImportStatsYear", acNormal, acEdit
'Append stats data from tblDDMandateImport to tblREJ6StatsDGI table
DoCmd.OpenQuery "qryAppDDMandateImportStatsREJ6DGI", acNormal, acEdit
'Append stats data from tblDDMandateImport to tblREJ6StatsDGS table
DoCmd.OpenQuery "qryAppDDMandateImportStatsREJ6DGS", acNormal, acEdit
'Append stats data from tblDDMandateImport to tblREJ6StatsSky table
DoCmd.OpenQuery "qryAppDDMandateImportStatsREJ6Sky", acNormal, acEdit
'Append the data from the tblDGI2_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppDGI2_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblDGI_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppDGI_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblDGS2_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppDGS2_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblDGS_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppDGS_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblSky2_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppSky2_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblSky_NoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryAppSky_NoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append the data from the tblDGI2_NoPostCode table to the tblLetterRunDGI2 table
DoCmd.OpenQuery "qryAppDGI2_NoPostCodeTotblLetterRunDGI2", acNormal, acEdit
'Append the data from the tblDGI_NoPostCode table to the tblLetterRunDGI table
DoCmd.OpenQuery "qryAppDGI_NoPostCodeTotblLetterRunDGI", acNormal, acEdit
'Append the data from the tblDGS2_NoPostCode table to the tblLetterRunDGS2 table
DoCmd.OpenQuery "qryAppDGS2_NoPostCodeTotblLetterRunDGS2", acNormal, acEdit
'Append the data from the tblDGS_NoPostCode table to the tblLetterRunDGS table
DoCmd.OpenQuery "qryAppDGS_NoPostCodeTotblLetterRunDGS", acNormal, acEdit
'Append the data from the tblSky2_NoPostCode table to the tblLetterRunSky2 table
DoCmd.OpenQuery "qryAppSky2_NoPostCodeTotblLetterRunSky2", acNormal, acEdit
'Append the data from the tblSky_NoPostCode table to the tblLetterRunSky table
DoCmd.OpenQuery "qryAppSky_NoPostCodeTotblLetterRunSky", acNormal, acEdit
'Appends the data from the tblNoAddress table to the tblNoAddressStats table
DoCmd.OpenQuery "qryApptblNoAddressTotblNoAddressStats", acNormal, acEdit
'Appends the data from the tblDGI2_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblDGI2_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblDGI_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblDGI_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblDGS2_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblDGS2_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblDGS_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblDGS_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblSky2_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblSky2_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblSky_NoPostCode table to the tblNoPostCode table
DoCmd.OpenQuery "qryApptblSky_NoPostCodeTotblNoPostCode", acNormal, acEdit
'Appends the data from the tblNoPostCode table to the tblNoPostCodeStats table
DoCmd.OpenQuery "qryApptblNoPostCodeTotblNoPostCodeStats", acNormal, acEdit
'Append data with the Letter Code "REJ6" to the tblREJ6DGI table
DoCmd.OpenQuery "qryAppREJ6LetterCodeTotblREJ6DGI", acNormal, acEdit
'Append data with the Letter Code "REJ6" to the tblREJ6DGS table
DoCmd.OpenQuery "qryAppREJ6LetterCodeTotblREJ6DGS", acNormal, acEdit
'Append data with the Letter Code "REJ6" to the tblREJ6Sky table
DoCmd.OpenQuery "qryAppREJ6LetterCodeTotblREJ6Sky", acNormal, acEdit
'Print DGI Seperator Page
DoCmd.OpenReport "rptDGI_Seperator", acNormal, "", ""
'Print the DGI rptDDLetterRun report
DoCmd.OpenReport "rptDDLetterRunDGI", acNormal, "", ""
'Print DGS Seperator Page
DoCmd.OpenReport "rptDGS_Seperator", acNormal, "", ""
'Print the DGS rptDDLetterRun report
DoCmd.OpenReport "rptDDLetterRunDGS", acNormal, "", ""
'Print Sky Seperator Page
DoCmd.OpenReport "rptSky_Seperator", acNormal, "", ""
'Print the Sky rptDDLetterRun report
DoCmd.OpenReport "rptDDLetterRunSky", acNormal, "", ""
'If the tables tblLetterRunDGI2, tblLetterRunDGS2 or tblLetterRunSky2 have records in them then
If DCount("*", "tblLetterRunDGI2") > 0 And DCount("*", "tblLetterRunDGS2") > 0 _
And DCount("*", "tblLetterRunSky2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the tables tblLetterRunDGI2 and tblLetterRunDGS2 have records in them then
If DCount("*", "tblLetterRunDGI2") > 0 And DCount("*", "tblLetterRunDGS2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the tables tblLetterRunDGI2 and tblLetterRunSky2 have records in them then
If DCount("*", "tblLetterRunDGI2") > 0 And DCount("*", "tblLetterRunSky2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the tables tblLetterRunDGS2 and tblLetterRunSky2 have records in them then
If DCount("*", "tblLetterRunDGS2") > 0 And DCount("*", "tblLetterRunSky2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the table tblLetterRunDGI2 has records in it then
If DCount("*", "tblLetterRunDGI2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the table tblLetterRunDGS2 has records in it then
If DCount("*", "tblLetterRunDGS2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
Else
'If the table tblLetterRunSky2 has records in it then
If DCount("*", "tblLetterRunSky2") > 0 Then
'Print rptNoDDMandate_Seperator
DoCmd.OpenReport "rptNoDDMandateS_Seperator"
End If
End If
End If
End If
End If
End If
End If
'If the tblLetterRunDGI table has records in it then
If DCount("*", "tblLetterRunDGI2") > 0 Then
'Print the DGI rptLetterRun Report
DoCmd.OpenReport "rptLetterRunDGI", acNormal, "", ""
End If
'If the tblLetterRunDGS table has records in it then
If DCount("*", "tblLetterRunDGS2") > 0 Then
'Print the DGS rptLetterRun Report
DoCmd.OpenReport "rptLetterRunDGS", acNormal, "", ""
End If
'If the tblLetterRunSky table has records in it then
If DCount("*", "tblLetterRunSky2") > 0 Then
'Print the Sky rptLetterRun Report
DoCmd.OpenReport "rptLetterRunSky", acNormal, "", ""
End If
'Print the rptDailyLetterCount report
DoCmd.OpenReport "rptDailyLetterCount", acNormal, "", ""
'If the tblREJ6DGI table has records in it then
If DCount("*", "tblREJ6DGI") > 0 Then
'Print the rptREJ6ListingDGI
DoCmd.OpenReport "rptREJ6ListingDGI", acNormal, "", ""
End If
'If the tblREJ6DGS table has records in it then
If DCount("*", "tblREJ6DGS") > 0 Then
'Print the rptREJ6ListingDGS
DoCmd.OpenReport "rptREJ6ListingDGS", acNormal, "", ""
End If
'If the tblREJ6Sky table has records in it then
If DCount("*", "tblREJ6Sky") > 0 Then
'Print the rptREJ6ListingSky
DoCmd.OpenReport "rptREJ6ListingSky", acNormal, "", ""
End If
'If the tblNoAddress table has records in it then
If DCount("*", "tblNoAddress") > 0 Then
'Print the rptNoAddress report
DoCmd.OpenReport "rptNoAddress", acNormal, "", ""
End If
'If the tblNoPostCode table has records in it then
If DCount("*", "tblNoPostCode") > 0 Then
'Print the rptNoAddress report
DoCmd.OpenReport "rptNoPostCode", acNormal, "", ""
End If
'Append the data from the tblDDMandateImport table to the tblDDMandateImportHistory table
DoCmd.OpenQuery "qryAppDDMandateImportToDDMandateHistory", acNormal, acEdit
Dim dtmDate 'Declare dtmDate variable
Dim CurrentDay 'Declare CurrentDay variable
CurrentDay = Format(Now(), "dd/mm/yy")
Call LastWorkDay 'Call the LastWorkDay Function
LastWorkDayOfMonth = LastWorkDay 'Assign the value of LastWorkDay to the LastWorkDayOfMonth variable
'If the current date ie equal to the LastWork Day Of The Month then
If CurrentDay = LastWorkDayOfMonth Then
'Print the Montly Letter Type Chart
DoCmd.OpenReport "rptChartMonthlyLetterCount", acNormal, "", ""
End If
'Delete the contents of the tblDDMandateImport table
DoCmd.OpenQuery "qryDelDDMandateImport", acNormal, acEdit
'Delete the contents of the tblLetterRunDGI table
DoCmd.OpenQuery "qryDelLetterRunDGI", acNormal, acEdit
'Delete the contents of the tblLetterRunDGS table
DoCmd.OpenQuery "qryDelLetterRunDGS", acNormal, acEdit
'Delete the contents of the tblLetterRunSky table
DoCmd.OpenQuery "qryDelLetterRunSky", acNormal, acEdit
'Delete the contents of the tblREJ6DGI table
DoCmd.OpenQuery "qryDeltblREJ6DGI", acNormal, acEdit
'Delete the contents of the tblREJ6DGS table
DoCmd.OpenQuery "qryDeltblREJ6DGS", acNormal, acEdit
'Delete the contents of the tblREJ6Sky table
DoCmd.OpenQuery "qryDeltblREJ6Sky", acNormal, acEdit
'Delete the Contents of the tblLetterRunDGI2 table
DoCmd.OpenQuery "qryDelLetterRunDGI2", acNormal, acEdit
'Delete the Contents of the tblLetterRunDGS2 table
DoCmd.OpenQuery "qryDelLetterRunDGS2", acNormal, acEdit
'Delete the Contents of the tblLetterRunSky2 table
DoCmd.OpenQuery "qryDelLetterRunSky2", acNormal, acEdit
'Delete the contents of the tblDGI2_NoPostCode table
DoCmd.OpenQuery "qryDeltblDGI2_NoPostCode", acNormal, acEdit
'Delete the contents of the tblDGI_NoPostCode table
DoCmd.OpenQuery "qryDeltblDGI_NoPostCode", acNormal, acEdit
'Delete the contents of the tblDGS2_NoPostCode table
DoCmd.OpenQuery "qryDeltblDGS2_NoPostCode", acNormal, acEdit
'Delete the contents of the tblDGS_NoPostCode table
DoCmd.OpenQuery "qryDeltblDGS_NoPostCode", acNormal, acEdit
'Delete the contents of the tblSky2_NoPostCode table
DoCmd.OpenQuery "qryDeltblSky2_NoPostCode", acNormal, acEdit
'Delete the contents of the tblSky_NoPostCode table
DoCmd.OpenQuery "qryDeltblSky_NoPostCode", acNormal, acEdit
'Delete the contents of the tblNoAddress table
DoCmd.OpenQuery "qryDeltblNoAddress", acNormal, acEdit
'Delete the contents of the tblNoPostCode table
DoCmd.OpenQuery "qryDeltblNoPostCode", acNormal, acEdit
'Export the tblDDMandateImport table to the E Drive Test Data Folder and replace the existing ADDLPImport.txt file
DoCmd.TransferText acExportFixed, "ADDLPImportSpec", "tblDDMandateImport", "C:\JohnLeeBackupInformation\ADDLPImport.txt", False, ""
'Backup Process - Copy the tables listed below to the backup Database ADDLP BU.mdb
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblCompanyTypes", "tblCompanyTypes", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblDDMadateStats", "tblDDMadateStats", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblDDMandateImportHistory", "tblDDMandateImportHistory", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblDDMandateStatsDGI", "tblDDMandateStatsDGI", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblDDMandateStatsDGS", "tblDDMandateStatsDGS", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblDDMandateStatsSky", "tblDDMandateStatsSky", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblLetterTypeCode", "tblLetterTypeCode", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblREJ6StatsDGI", "tblREJ6StatsDGI", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblREJ6StatsDGS", "tblREJ6StatsDGS", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblREJ6StatsSky", "tblREJ6StatsSky", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblNoAddressStats", "tblNoAddressStats", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblNoNoPostCodeStats", "tblNoPostCodeStats", False
''DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\JohnLeeBackupInformation\ADDLP Design BU.mdb", acTable, "tblUserID", "tblUserID", False
Dim TextString3 'Declares the TextString3 variable
TextString3 = "DIRECT DEBIT LETTER " & vbCr
TextString3 = TestString3 & "AND BACKUP PROCESS COMPLETED"
'Outputs the contents of the TextString3 as an on screen message
MsgBox TextString3, vbInformation, "DIRECT DEBIT LETTER AND BACKUP PROCESS"
DoCmd.Echo True, ""
DoCmd.Hourglass False 'Turn Off the Hour Glass
DoCmd.SetWarnings True 'Turn on the Warnings
End Function
====================
END CODE
====================
Thanks in advance.
John
