Cliff:
Our previous posts have been scrambled (with spaces missing between words).
I hope this doesn't happen to the code below.
Follow these steps in your database:
1. Create a new (blank) module.
2. If the following two code lines appear at the top of the module,
delete them:
Option Compare Database
Option Explicit
3. Highlight and copy the code below and paste it into the module.
(Don't copy the lines "Code Begins" and "Code Ends".)
4. Open the DEBUG menu and select COMPILE. (The code should compile OK.)
5. Open the FILE menu and select SAVE. Give the module the name
"UpdateLedgerData". (In fact, you can name the module anything you like,
but you must change the constant mstrcModuleName to reflect the name you
give the module.)
6. In future, to update data, run the subprocedure, "UpdateData". This
subprocedure has been declared as PUBLIC, so you can, if you like, assign
the subprocedure to a custom toolbar button in the database window. (Post
again if you need help with this.)
7. You need to amend the subprocedure "MacroToUpdateData". It calls your
macro to update the data.
Post again if you have questions.
Geoff
CODE BEGINS:
Option Compare Database
Option Explicit
' NOTES:
'
' When the main routine below updates the database,
' it stores the date of the file "Ledger.txt" in the
' constant mdatcDatabaseModified. The next time this
' code updates the database, it compares the date of
' the file "Ledger.txt" against the constant. If
' file's date is more recent, the update proceeds
' and the constant is updated.
' CONSTANTS:
' Amend the next two constants to reflect your system:
Private Const mstrcModuleName As String = "UpdateLedgerData"
Private Const mstrcFilePathName As String = "C:\Data\Ledger.txt"
' The following constant will be updated automatically by
' code in this module:
Private Const mdatcDatabaseModified As Date = #1/1/2007 1:01:00 PM#
' VARIABLES:
Private mdatLedgerFileModified As Date
Public Sub UpdateData()
' Main routine.
' Run this subprocedure to update your data.
Dim fUpdateNow As Boolean
On Error GoTo Error_UpdateData
' For debugging purposes, show date/time database
' last modified in Immediate window.
' CTRL-G displays the Immediate window.
Debug.Print "DATABASE PREVIOUSLY MODIFIED:"
Debug.Print " " & mdatcDatabaseModified
Debug.Print " Day: " & Day(mdatcDatabaseModified)
Debug.Print " Month: " & Month(mdatcDatabaseModified)
Debug.Print " Year: " & Year(mdatcDatabaseModified)
Debug.Print " Hour: " & Hour(mdatcDatabaseModified)
Debug.Print " Minute: " & Minute(mdatcDatabaseModified)
Debug.Print " Second: " & Second(mdatcDatabaseModified)
' Get date/time the Ledger file was last modified:
mdatLedgerFileModified = FileDateTime(mstrcFilePathName)
Debug.Print "LEDGER FILE MODIFICATION DATE:"
Debug.Print " " & mdatLedgerFileModified
Debug.Print " Day: " & Day(mdatLedgerFileModified)
Debug.Print " Month: " & Month(mdatLedgerFileModified)
Debug.Print " Year: " & Year(mdatLedgerFileModified)
Debug.Print " Hour: " & Hour(mdatLedgerFileModified)
Debug.Print " Minute: " & Minute(mdatLedgerFileModified)
Debug.Print " Second: " & Second(mdatLedgerFileModified)
' See if the ledger file has been modified
' since the database was last updated and store
' result in Boolean variable, fUpdateNow:
fUpdateNow = (mdatLedgerFileModified > mdatcDatabaseModified)
' Take appropriate action:
If fUpdateNow Then
GoTo UpdateDatabase
Else
GoTo DontUpdateDatabase
End If
Exit_UpdateData:
Exit Sub
UpdateDatabase:
Call MacroToUpdateData
Call UpdateDateTimeDatabaseModified
MsgBox "Update finished.", vbOKOnly + vbInformation, _
"Information"
GoTo Exit_UpdateData
DontUpdateDatabase:
MsgBox mstrcFilePathName & vbNewLine & vbNewLine _
& "The above file has not been modified since the " _
& "database was last updated.", _
vbOKOnly + vbInformation, "Update Status"
GoTo Exit_UpdateData
Error_UpdateData:
MsgBox "The following error has occurred:" _
& vbNewLine & vbNewLine _
& "Error No: " & Err.Number & vbNewLine _
& "Description: " & Err.Description, _
vbOKOnly + vbExclamation, _
"Error Updating Data"
GoTo Exit_UpdateData
End Sub
Private Sub MacroToUpdateData()
' Assumes you have a macro that updates your database.
' To run your macro, remove leading apostrophe from the
' following DoCmd.RunMacro code line and replace
' YourMacroName with the name of your macro, leaving
' quotation marks in place.
' It should be possible to re-write your macro as VBA
' code to perform the same action.
'DoCmd.RunMacro "YourMacroName"
End Sub
Private Sub UpdateDateTimeDatabaseModified()
' This subprocedure updates the constant,
' mdatcDatabaseModified, at the top of this module
' to the modification date of the file, Ledger.txt.
' The constant that stores the date of Ledger.txt
' begins with the following text. This is the line
' we need to find and replace:
Const strcDatabaseModifiedLine As String = _
"Private Const mdatcDatabaseModified As Date = "
Dim objMOD As Access.Module
Dim fTextFound As Boolean
Dim lngStartLine As Long
Dim lngStartColumn As Long
Dim lngEndLine As Long
Dim lngEndColumn As Long
Dim strReplacementLine As String
' Create replacement line for the new constant:
strReplacementLine = strcDatabaseModifiedLine _
& "#" & mdatLedgerFileModified & "#"
Debug.Print "REPLACEMENT LINE FOR TOP OF MODULE:"
Debug.Print " " & strReplacementLine
' Point to this module:
Set objMOD = Access.Application.Modules(mstrcModuleName)
' Find the line number in this module that needs
' to be overwritten. The Find method returns TRUE
' if the string is found:
fTextFound = objMOD.Find( _
strcDatabaseModifiedLine, _
lngStartLine, lngStartColumn, _
lngEndLine, lngEndColumn)
' If line found, replace it:
If fTextFound Then
objMOD.ReplaceLine lngStartLine, strReplacementLine
End If
End Sub
CODE ENDS
