Auto save at specific times with changing saveas name

[SJW_OST]

I have an Excel file that I need to save-as automatically to a static
location of my choosing at 12Noon, 5:00pm & 11:59pm every day the file is
used, which is every day. When save-as occurs at these times, I need the file
to save with a name like "MyFile_todaysdate_1200.xls" or
"MyFile_todaysdate_1700.xls" or "MyFile_todaysdate_2359.xls". I know a file
can not use "/" in the filename so the date can look like 061808.
I just have not been able to peice this together with what little I know
along with posts I've read. I really appreciate any assistance with this.

 

[GTVT06]

hello,
Type this in a notepad, edit the path for the .xls document in the
code and save it as a .VBS file. Setup Windows scheduler to run
this .VBS file at 12pm, 5pm, and 11:59pm and it'll do what your
looking for.

Dim xlApp
set xlApp = CreateObject("Excel.Application")
xlapp.workbooks.open "C:\Documents and Settings\G\Desktop\Z\test.xls"
xlApp.Visible = True
set xlwb = xlapp.activeworkbook
Dim idate
Dim itime

idate = Month(Now) & Day(Now) & Year(Now) 'Format(Date, "mmddyy")
itime = FormatDateTime(Round(Time * 24, 0.1) / 24,vbshorttime)
'Round(Time * 24, 0.1) / 24, "hmm")

Select Case itime
Case "12:00","13:00"
itime = 1200
Case "17:00","18:00"
itime = 1700
Case "22:00","23:00","24:00"
itime = 2359
End Select

xlWB.saveas "C:\Documents and Settings\G\Desktop\Z\" & "MyFile_" &
idate & "_" & itime & ".xls"
xlWB.close
xlapp.quit
set xlwb = nothing
set xlapp = nothing

 

[SJW_OST]

Will this work with the file being open all day, not being closed until after
midnight, and constantly updated thru out the day by multiple users at the
same time in a ShareWorkbook status? I will try it and let you know the
result(s). Thank you very much!

 

[GTVT06]

Here you go:
In this code it assumes that if an open instance of Excel exists then
that means that "Test.xls" is already open. If an instance of Excel
don't exist then it will open excel, open the file, save it, and close
excel.
It'll save the file as "MyFile_" & irdate & "_" & irtime & ".xls" and
then save it back to "Test.xls" so that way the next time the script
run's it'll easily itentify the file.

Dim objXL
On Error Resume Next
Set objXL = GetObject(, "Excel.Application")
If Not TypeName(objXL) = "Empty" Then
objXL.Workbooks("Test.xls").Activate
set xlswb = objXL.activeworkbook
Dim irdate
Dim irtime


irdate = Month(Now) & Day(Now) & Year(Now) 'Format(Date,
"mmddyy")
irtime = FormatDateTime(Round(Time * 24, 0.1) / 24,vbshorttime)



Select Case irtime
Case "12:00","13:00"
irtime = 1200
Case "17:00","18:00"
irtime = 1700
Case "22:00","23:00","24:00"
irtime = 2359
End Select


xlswb.saveas "C:\Documents and Settings\DT42921\Desktop\TEST VBS\" &
"MyFile_" & irdate & "_" & irtime & ".xls"
xlswb.saveas "C:\Documents and Settings\DT42921\Desktop\TEST VBS
\Test.xls.xls"

set xlswb = nothing
set objXL = nothing

Else

Dim xlApp
set xlApp = CreateObject("Excel.Application")
xlapp.workbooks.open "C:\Documents and Settings\DT42921\Desktop\TEST
VBS\test.xls"
xlApp.Visible = True
set xlwb = xlapp.activeworkbook
Dim idate
Dim itime


idate = Month(Now) & Day(Now) & Year(Now) 'Format(Date, "mmddyy")
itime = FormatDateTime(Round(Time * 24, 0.1) / 24,vbshorttime)



Select Case itime
Case "12:00","13:00"
itime = 1200
Case "17:00","18:00"
itime = 1700
Case "22:00","23:00","24:00"
itime = 2359
End Select


xlWB.saveas "C:\Documents and Settings\DT42921\Desktop\TEST VBS\" &
"MyFile_" & idate & "_" & itime & ".xls"
xlWB.close
xlapp.quit
set xlwb = nothing
set xlapp = nothing

End If

 

[SJW_OST]

With some tweeking, this will work great. Thank you!

 

[GTVT06]

Your welcome.