Save as button for Excel

Whoops sorry ignore this one.

John,

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

VB Code:

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

Thanks Danny i'll give it a go.

Sounds like just the code i need.

John

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


John

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

Code:

---

  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 ...

---

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

VB Code:

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

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

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

VB Code:

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

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

VB Code:

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..

VB Code:

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

Thanks Danny your a star, it works fine now.


John