Save As by date

[Wheelie686]

Every Saturday I need to save 7 files, each having a file name with the dates of the upcoming week (our work week starts on a Saturday). Is there a "Save As" type macro I can create - something like Current Date, Current Date+1, Current Date+2, etc...?

[HaHoBe]

Hi, Wheelie686,

maybe this sniplet may give you an idea of how to solve the problem:

Sub Wheelie686()
Dim datSaveFile As Date
Dim lngCounter As Long

datSaveFile = Date
For lngCounter = 0 To 6
  Debug.Print DateAdd("d", lngCounter, datSaveFile)
Next lngCounter
End Sub

Ciao,
Holger

[brynbaker]

Sub weeksaver()
    d = Int(Now()) 'todays date without time
    For d = d To d + 6
        ActiveWorkbook.SaveAs Format(d, "dd mmm yyyy")
    Next
End Sub

This saves the files as (e.g.) 30 Oct 2012.xls but you can change the format to suit and precede with a constant if you need.

[Wheelie686]

Thank you brynbaker. That somewhat does what I want but two issues I would not have expected.
1. It will not let me save where I want, it defaults to a hidden Excel directory on my PC.
2. The name I want to use is (for today for example) is Aliant Intraday Report Avaya 2012-10-27 but it came out Alia0t I0tra27a301 Report Ava301a 2012-10-27. It's like it has problems with the letters N, D and Y. I can't say I've ever seen that before lol.

[HaHoBe]

Hi, Wheelie686,

It will not let me save where I want, it defaults to a hidden Excel directory on my PC.

Is this place a given folder or do you want to choose it from time to time?

ActiveWorkbook.SaveAs "C:\Temp\" & Format(d, "dd mmm yyyy") & ".xlsx", FileFormat:=xlOpenXMLWorkbook

ActiveWorkbook.SaveCopyAs "C:\Temp\Aliant Intraday Report Avaya " & Format(Date, "yyyy-mm-dd") & ".xlsx", FileFormat:=xlOpenXMLWorkbook

It's like it has problems with the letters N, D and Y.

Sure, as in the format function these are laid out for Months, Days, and Years. As you didnīt the post probably you included the whole of the variable into the format string?

Ciao,
Holger

[Wheelie686]

HaHoBe - I would actually like to pick where I want to save it even though I'll probably end up putting it in the same place every week.

The code I have now is:

Sub SaveAsSat()
    d = Int(Now()) 'todays date without time
    For d = d To d + 1
        ActiveWorkbook.SaveAs Format(d, "Aliant Intraday Report Avaya yyyy-mm-dd")
    Next
End Sub

[HaHoBe]

Hi, Wheelie686,

there you are - if you use the whole name inside the format you have to mask the characters so that VBA will not replace them. Iīd preferred to split things up into two parts - the name and the date part (no worry for VBA changing characters there).

Copy and insert the following function into your module:

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=284

     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function

And alter your code to read

Sub SaveAsSat()
Dim varFolder
Dim d As Date

varFolder = BrowseForFolder
If varFolder <> vbFalse Then
    d = Date
    For d = d To d + 1
        ActiveWorkbook.SaveAs varFolder & "\" & Format(d, "Alia\nt I\ntra\da\y Report Ava\ya yyyy-mm-dd")
    Next d
End If
End Sub

Ciao,
Holger

[Wheelie686]

That worked for the macro that will save Saturday's report but yet when I copy it to create the following days' reports, knowing I have to add + 1,2,etc.. then it doesn't run. The two should be nearly identical, with the excetion of the + 1.

Sub SaveAsSat()
Dim varFolder
Dim d As Date

varFolder = BrowseForFolder
If varFolder <> vbFalse Then
    d = Date
    For d = d To d
        ActiveWorkbook.SaveAs varFolder & "\" & Format(d, "Alia\nt I\ntra\da\y Report Ava\ya yyyy-mm-dd")
    Next d
End If
End Sub

Sub SaveAsSun()
Dim varFolder
Dim d As Date

varFolder = BrowseForFolder
If varFolder <> vbFalse Then
    d = Date
    For d = d To d + 1
        ActiveWorkbook.SaveAs varFolder & "\" & Format(d, "Alia\nt I\ntra\da\y Report Ava\ya yyyy-mm-dd")
    Next d
End If
End Sub

[HaHoBe]

Hi, Wheelie686,

try this (sorry but I did just realize that the counter was identical to the values which where used):

Sub SaveAsSat()
Dim varFolder
Dim d As Date
Dim lngCounter As Long

varFolder = BrowseForFolder
If varFolder <> vbFalse Then
    d = Date
    For lngCounter = d To d + 6
        ActiveWorkbook.SaveAs varFolder & "\" & Format(lngCounter, "Alia\nt I\ntra\da\y Report Ava\ya yyyy-mm-dd")
    Next lngCounter
End If
End Sub

There will be the question to overwrite if the file already exists - I already had created the first files and had them replaced.

Ciao,
Holger