Save as button for Excel

[jjchad]

Whoops sorry ignore this one.

[dannymking]

John,

If you set the limits on the shifts within the code, you can keep this down to just one button..


Dim TimeNow as Date
TimeNow = Now
If TimeNow <= CDate(#12:00:00 PM#) And TimeNow >= CDate(#6:00:00 AM#) Then
ActiveWorkbook.SaveAs "Morning File"
ElseIf TimeNow >= CDate(#12:00:01 PM#) And TimeNow <= CDate(#6:00:00 PM#) Then
Activeworkbook.SaveAs "Afternoon File"
ElseIf TimeNow >= CDate(#6:00:01 PM#) And TimeNow <= CDate(#12:00:00 AM#) Then
ActiveWorkbook.SaveAs "Evening File"
Else
ActiveWorkbook.SaveAs "Night File"
End If

[jjchad]

Thanks Danny i'll give it a go.

Sounds like just the code i need.

John

[jjchad]

Just one question Danny what code should i use to specify where to save the file.?


John

[dannymking]

John..

This one..

ActiveWorkbook.SaveAs "Morning File"

Replace the "Morning File" with the pathname and filename you want to save it.

If you need to save the file as a dynamic filename then capture the filename above the If statement and then use it like so


Dim FileName As String
FileName = "FileDated" & Format(Date,"mmddyyyy") 'Or you localised setting
Dim TimeNow as Date
TimeNow = Now
If TimeNow <= CDate(#12:00:00 PM#) And TimeNow >= CDate(#6:00:00 AM#) Then
ActiveWorkbook.Save As "C:\MorningFiles\" & FileName
ElseIf ...

[jjchad]

Hi Danny i'm not sure i'm doint this right, this is my code so far:

Dim TimeNow As Date
TimeNow = Now

If TimeNow >= CDate(#6:00:00 AM#) And TimeNow <= CDate(#2:00:00 PM#) Then
ActiveWorkbook.SaveAs "Mornings"
ElseIf TimeNow >= CDate(#2:00:01 PM#) And TimeNow <= CDate(#10:00:00 PM#) Then
ActiveWorkbook.SaveAs "Afternoons"
ElseIf TimeNow >= CDate(#10:00:01 PM#) And TimeNow <= CDate(#6:00:00 AM#) Then
ActiveWorkbook.SaveAs "Nights"
End If

It's not saving the file thou any idea's why.?


John

[dannymking]

It wont do as

"Mornings" is not a valid path for a file to be saved.. this will need to be something like "C:\Mornings\" &filename

check Post #5

[jjchad]

Danny i've tried this too but no luck.?

Dim TimeNow As Date
Dim FileName As String
TimeNow = Now

FileName = "FileDated" & Format(Date, "mmddyyyy") 'Or you localised setting

If TimeNow <= CDate(#6:00:00 AM#) And TimeNow >= CDate(#2:00:00 PM#) Then
ActiveWorkbook.SaveAs "C:\Documents and Settings\John Chadwick\My Documents\Andon\Mornings" & FileName

ElseIf TimeNow >= CDate(#2:00:01 PM#) And TimeNow <= CDate(#10:00:00 PM#) Then
ActiveWorkbook.SaveAs "C:\Documents and Settings\John Chadwick\My Documents\Andon\Afternoons" & FileName

ElseIf TimeNow >= CDate(#10:00:01 PM#) And TimeNow <= CDate(#6:00:00 AM#) Then
ActiveWorkbook.SaveAs "C:\Documents and Settings\John Chadwick\My Documents\Andon\Nights" & FileName
End If

John

[dannymking]

Sorry My Bad..

You need to add the extension on the filename..

Your code is also slightly wrong.. The first if statement's between statement is stopping the first file from being create switch it to this


Dim TimeNow As Date
Dim FileName As String
TimeNow = Format(Now, "HH:NN:SS")

FileName = "FileDated" & Format(Date, "mmddyyyy") & ".xls" 'Or you localised setting

If TimeNow >= CDate(#6:00:00 AM#) And TimeNow <= CDate(#2:00:00 PM#) Then
ActiveWorkbook.SaveAs "C:\" & FileName
ElseIf TimeNow >= CDate(#2:00:01 PM#) And TimeNow <= CDate(#10:00:00 PM#) Then
ActiveWorkbook.SaveAs "C:\" & FileName
ElseIf TimeNow >= CDate(#10:00:01 PM#) And TimeNow <= CDate(#5:59:59 AM#) Then
ActiveWorkbook.SaveAs "C:\" & FileName
End If


Your folders will also have to exist otherwise it will error out.. the create the folders you will need to create them one at a time, this example could go between the if and first elseif statemtent, and then replicate for the others..


On Error Resume Next 'will prevent the error if the path already exists
MkDir "C:\MyFilesOutput\"
MkDir "C:\MyFilesOutput\Mornings\"
On Error GoTo 0 'switch off error trapping

[jjchad]

Thanks Danny your a star, it works fine now.


John