View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
SJW_OST[_2_] SJW_OST[_2_] is offline
external usenet poster
 
Posts: 39
Default Auto save at specific times with changing saveas name

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

"GTVT06" wrote:

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