Code not working - autosave copy

[zeroflight]

So I've been trying to put together some code that AutoSaves any and all open documents into a single folder every 5 minutes (code is set to 10 seconds for testing purposes). Saves as original filename + date and as extension xlsx. I can get it to run manually but not automatically. Below is the code I have in a module in my Personal.xlsb. Ideas on what I'm doing wrong? I'm not particularly good at code so you may have to speak slowly. What I do have is somewhat cobbled together from a lot of other similar examples out there, but I didn't find any that fit exactly.

Ideas?

<code class=" language-vbnet">Private Sub Workbook_Open()
    dTime = Now + TimeValue("00:00:10")
    Application.OnTime dTime, "AutoSaveMacro"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Application.OnTime dTime, "AutoSaveMacro", , False
End Sub
 
Public dTime As Date
Sub AutoSaveMacro()
    dTime = Now + TimeValue("00:00:10")
    ThisWorkbook.SaveCopyAs Filename:= _
        "C:\AutoSave\" & _
        Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".", , vbTextCompare) - 1) & _
        "_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
End Sub</code>

 

[NdNoviceHlp]

Hi zeroflight and Welcome to the Board! HTh. Dave
workbook code....

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:10"), "AutoSaveMacro"
End Sub

module code...

Public Sub AutoSaveMacro()
Dim NowStr As String
'*new file every time interval
'NowStr = Format(Now, "yyyy/mm/dd.Hh.Nn.ss ")

'*new file every day
NowStr = Format(Date, "yyyy-mm-dd")
ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.FullName & _
        "_" & NowStr & ".xlsm"
Application.OnTime Now + TimeValue("00:00:10"), "AutoSaveMacro"
End Sub

 

[zeroflight]

Thanks! With a little modification I have it changed to the below to fit my needs and better output what & where I want. But that still leaves me with the problem of it not running automatically on all excel files getting opened; it only runs on the Personal.xlsb file. Don't know if I'm going to have to code this as an plugin instead but that would actually be handy for distributing to others in the office.

Public Sub AutoSaveMacro()
Dim NowStr As String

'NowStr = Format(Now, "yyyy/mm/dd.hh.nn.ss ")
'*Date string added to file
NowStr = Format(Now(), "yy-MM-dd.hh.nn")

'Save copy of file to C:\Autosave as file type xlsx
'Save original filename + date string + .xlsx
ThisWorkbook.SaveCopyAs Filename:="C:\AutoSave\" & _
        Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".", , vbTextCompare) - 1) & _
        "_" & NowStr & ".xlsx"

'Time interval to run
Application.OnTime Now + TimeValue("00:00:10"), "AutoSaveMacro"

End Sub

 

[NdNoviceHlp]

Not clear on your needs. U want any/all open XL files to be saved without having the code in them? That sounds like an addin maybe, Dave