After File Open, Display a Timer

[dkauf]

I have an Excel file with macros that I intend to call automatically when the Excel file is opened. The file will be opened regularly via Task Scheduler.

However, there will be times when I'll need to open the file manually and call the macros via their control buttons. I'm struggling because if I open the file manually, the auto_run kicks on the macros, which I don't want to happen when I open it myself.

Thus, I am wondering if there is a way for a message box to appear via the auto_run macro that displays a 10 second timer that counts down. Essentially, the message box would be looking for the user to press "OK" to abort the auto_run macro, which would allow me to poke around the file and call the individual macros manually. If, after 10 seconds, OK is not pressed, then the auto_run macro proceeds as planned. This way it can still be called via task scheduler and run as directed on auto pilot.

Is this even remotely possible?

Thanks!

 

[kpark91]

Hi, dkauf. It is posibble with a combination of DoEvents and Time functions.

although this code will only show the current time continuously, I think it's worth having a look at it and perhaps tweak it for ur use. plus I need to leave soon.

Timer_Loop:
        DoEvents
        NowTimer = Format(Time, "HH:MM:SS AM/PM ")
        GoTo Timer_Loop

Then you would want a IF statement after DoEvents to allow you to check the countdown everytime it runs. Probably something along the lines of

StopTimer = Time + TimeValue("0:00:10")
Timer_Loop:
DoEvent
   NowTimer = Time
   ans = MsgBox (Time, vbOkOnly) 'unsure
   If Time >= StopTimer Then
       'Run Macro
   End If
   GoTo Timer_Loop

 

[dkauf]

Thanks for that info. I am still playing around with it. Below is the code that I currently use to run my macro. It is triggered by a command button.

What I want to happen is for this macro to be called automatically upon file open. At that point, a message box will appear asking the user to press OK to bypass the automated macro. If OK is pressed, the auto_macro is killed and the user can manually run the macro via the command button. If, however, no button is pressed within say 10 seconds, then the auto_macro runs as planned. This will allow me the flexibility of setting the macro to run on a schedule OR it can be run manually via the button.

Thanks

Sub RDB_Worksheet_Or_Worksheets_To_PDF()
    Dim FileName As String
    
    ActiveWorkbook.RefreshAll
    
    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more than one sheet selected," & vbNewLine & _
               "and every selected sheet will be published."
    End If

    'Call the function with the correct arguments.
    'You can also use Sheets("Sheet3") instead of ActiveSheet in the code(the sheet does not need to be active then).
    FileName = RDB_Create_PDF(Sheets("Summary"), "H:\Executive Reports\Revenue Summary\" & Range("AS1") & " " & Format(Date, "MMDDYYYY") & ".pdf", True, False)

    'For a fixed file name and to overwrite it each time you run the macro, use the following statement.
    'RDB_Create_PDF(ActiveSheet, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Uncomment the following statement if you want to send the PDF by e-mail.
        RDB_Mail_PDF_Outlook FileName, Range("AS2"), Range("AS3"), Range("AS5"), Range("AS6"), _
           Range("AS7") _
          & vbNewLine & vbNewLine & "Thanks", True
    Else
        MsgBox "It is not possible to create the PDF; possible reasons:" & vbNewLine & _
               "Add-in is not installed" & vbNewLine & _
               "You canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to save the file is not correct" & vbNewLine & _
               "PDF file exists and you canceled overwriting it."
    End If
End Sub

 

[dkauf]

OK I've got the timer and msgBox figured out. It works perfectly assuming Excel is already open when the file is opened. If Excel is closed when the file is first opened, then the timer hangs and never kicks out.

I'm soooo close - this seems like a easy fix. Can anyone help?

Private Sub Workbook_Open()
    Dim FileName As String
    Dim WSH As IWshRuntimeLibrary.WshShell
    Dim Res As Long
    
    Set WSH = New IWshRuntimeLibrary.WshShell
    Res = WSH.Popup(Text:="Press CANCEL within 10s to abort Auto Run Macro", secondstowait:=10, _
        Title:="Auto Run Warning", Type:=vbOKCancel + vbExclamation)
    If Res = 2 Then Exit Sub
    
    ActiveWorkbook.RefreshAll
        
    
    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more than one sheet selected," & vbNewLine & _
               "and every selected sheet will be published."
    End If

    'Call the function with the correct arguments.
    'You can also use Sheets("Sheet3") instead of ActiveSheet in the code(the sheet does not need to be active then).
    FileName = RDB_Create_PDF(Sheets("Summary"), "H:\Executive Reports\Revenue Summary\" & Range("AS1") & " " & Format(Date, "MMDDYYYY") & ".pdf", True, False)

    'For a fixed file name and to overwrite it each time you run the macro, use the following statement.
    'RDB_Create_PDF(ActiveSheet, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)

    If FileName <> "" Then
        'Uncomment the following statement if you want to send the PDF by e-mail.
        RDB_Mail_PDF_Outlook FileName, Range("AS2"), Range("AS3"), Range("AS5"), Range("AS6"), _
           Range("AS7") _
          & vbNewLine & vbNewLine & "Thanks", True
    Else
        MsgBox "It is not possible to create the PDF; possible reasons:" & vbNewLine & _
               "Add-in is not installed" & vbNewLine & _
               "You canceled the GetSaveAsFilename dialog" & vbNewLine & _
               "The path to save the file is not correct" & vbNewLine & _
               "PDF file exists and you canceled overwriting it."
    End If
    
    ActiveWorkbook.Close SaveChanges:=True
End Sub

 

[dkauf]

Any ideas?