VBA Run Macro Once a Day

Question

I need some code to run a macro just once a day, it doesn't matter how many times you open the file where is the macro.

If the file is not opened one day it doesn't have to run the macro, just do it when it is opened.

It has to have a ¨internal" variable or something like that, I guess, that keeps the info whether the macro has alredy run or not this day.

Besides, to make it more difficult, I suppose, the macro open a different Workbook each day.

Any thoughts.

I am novice, so forgive me if that is so clear. Thanks in advance.

EDITED: I found some code here:

that seems to do it but you have to create an extra sheet, I would like to dont do that.

Here is the code:

Private Sub Workbook_Open()
Dim rngFindTodaysDate As Range
    With ThisWorkbook.Worksheets("Status")

        On Error GoTo X
        Set rngFindTodaysDate = .Range("A1").End(xlDown).Find(Date)
        If rngFindTodaysDate Is Nothing Then
            .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1) = Date

            '''''  your Code  Here

        End If
    End With
    X:
End Sub

Answer 1

You can use Windows Task Scheduler to automatically open the file once a day. There's a really good step-by-step tutorial here with the required VB Script code included.

If the user may also be opening the file manually, you will want a state variable which records whether the macro has already run that day. The best bet is probably to have a sheet dedicated to recording this. Perhaps call it RunTimes. Then you can add the following line to your Workbook_Open event:

If Date > Application.Max(Sheets("RunRecords").Range("A:A")) Then
    Call YourMacroName
    Sheets("RunRecords").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Date
End If

Answer 2

Use a (named) range, a single cell, in your workbook where the last time & date the macro is run is stored by the macro itself:

Sheetx.Range("rLastRun").Value2 = Now()

Add that to the end of your macro or at least after the following check, where your macro checks if the last time run cell value is before today. Then the total would look like:

If Sheetx.Range("rLastRun").Value2 < Date Then

    <your macro>

    Sheetx.Range("rLastRun").Value2 = Now()

End If

---

For the opening a different file each time you have to be more specific as with the information provided so far we cannot help there. Ask youself the following:

1. Is there any logic in the files properties?
2. Does it have the same name every time except for a timestamp (eg. Input20121128.xls and Input20121127.xls?
3. Is the document name in a limited pool of possible names?
4. Is it always in the same folder?
5. Does it have a specific creator, date, time, ...?

With information provided your file lookup would be:

Dim strInputfile As String

<other code>

strInputfile = "<standardfolderstring>" & Format(Date, "dd/mm/yyyy") & " Test.xlsx"

Answer 3

Here is the logic, please look into it.

Store a value : e.g. 0 in a cell in the sheet target to run the macro. Then when macro is triggered, change that value to : e.g. 1. Then no matter how many times the sheet opens and macro gets invoked, sicne the cell valus is 1, the macro will exit and not complete the full process

Answer 4

Personally I prefer the ideas that others have suggested to solve this... possibly using a single cell, filled with the current date and colour the date white to hide it... If not give this a try:

If you do not want to have a work sheet, you could use an external text file, in the same dir for example. When the XLS opens it will read the textfile to see the current date, then if it doesn't match today, run your once a day code and update the text file to today's date else do nothing.

Public txt_file_location As String
Public txt_file_name As String
Private Sub Workbook_Open()

    txt_file_location = "C:\Documents and Settings\Chris\Desktop"
    txt_file_name = "test.txt"
    Dim dateToday As Date
    Dim dateInFile As Date
    dateToday = Date ' will be used for both comparison and for writing to txt file if need be
    dateInFile = txtfile_read(txt_file_location, txt_file_name)    ' On open - read the text file to check what the current date is.

    If (dateToday <> dateInFile) Then

        ' ok the date in the text file is different to today's date, so your script needs to be called here

        Call do_some_work ' a function that runs once a day...

        ' Now we need to update the textfile to todays date to prevent rerunning
        Call save_to_text_file(txt_file_location, txt_file_name, dateToday)
    Else
        MsgBox ("The script has already ran today")
    End If

End Sub
Sub do_some_work()

    ' here could be one of the functions that needs to run once a day
    MsgBox ("Some work was done!")

End Sub
Function txtfile_read(txt_file_dir, file_name)
    Dim iFileNumber As Long
    Dim strFilename As String
    strFilename = txt_file_dir & "\" + file_name
    iFileNumber = FreeFile()
    Open strFilename For Input As #iFileNumber
    Dim txt As Variant
    Do While Not EOF(iFileNumber)
        Line Input #iFileNumber, myLine
        txtfile_read = myLine
    Loop
    Close #iFileNumber
End Function
Function save_to_text_file(txt_file_dir, file_name, content_to_be_written)
    Dim iFileNumber As Long
    Dim strData As String
    Dim strFilename As String
    strFilename = txt_file_dir & "\" + file_name
    iFileNumber = FreeFile()
    Open strFilename For Output As #iFileNumber
    Print #iFileNumber, content_to_be_written
    Close #iFileNumber
End Function