Astrodude shared this with us in microsoft.public.excel.misc:
Hi
Is it possible to make a template that will create a workbook with
the current date as filename if it doesn't exists, or just opens the
file if it does?
This is how I do it weekly: (and I'm too lazy to edit the code for
readability)
-----CODE STARTS HERE-----
Option Explicit
Private Const mstrInitialen As String = "AVG"
Private Const mstrNaam As String = "Amedee Van Gasse"
Private Const mstrDirectory As String = "H:\DATA\EXCEL\Rapportering\"
Private Sub Workbook_Open()
WerkbladOpvolgingOpenen
End Sub
Sub WerkbladOpvolgingOpenen()
Dim strWeek As String
Dim strJaar As String
Dim strBestand As String
strWeek = Right("0" & CStr(ISOWeekNum(Date)), 2)
strJaar = CStr(DatePart("yyyy", Date, 2, 2))
strBestand = strJaar & " " & strWeek & " " & mstrInitialen & ".XLS"
On Error Resume Next
Workbooks.Open Filename:=mstrDirectory & strBestand
If Err.Number = 1004 Then ' Het bestand bestaat (nog) niet.
WerkbladOpvolgingNieuw strBestand, mstrDirectory
End If
End Sub
Sub WerkbladOpvolgingNieuw(strBestand As String, Optional strDirectory
As String)
Workbooks.Add Template:= _
"H:\DATA\Sjablonen\Overige documenten\Rapportering.xlt"
'Worksheets("DAGOVERZICHT").Select
Range("C1").Value = mstrNaam
Range("B5").Value = Date
Range("C5").Select
ChDir strDirectory
ActiveWorkbook.SaveAs Filename:=strDirectory & strBestand, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Public Function ISOWeekNum(AnyDate As Date, _
Optional WhichFormat As Variant) As Integer
'
' WhichFormat: missing or <> 2 then returns week number,
' = 2 then YYWW
'
Dim ThisYear As Integer
Dim PreviousYearStart As Date
Dim ThisYearStart As Date
Dim NextYearStart As Date
Dim YearNum As Integer
ThisYear = Year(AnyDate)
ThisYearStart = YearStart(ThisYear)
PreviousYearStart = YearStart(ThisYear - 1)
NextYearStart = YearStart(ThisYear + 1)
Select Case AnyDate
Case Is >= NextYearStart
ISOWeekNum = (AnyDate - NextYearStart) \ 7 + 1
YearNum = Year(AnyDate) + 1
Case Is < ThisYearStart
ISOWeekNum = (AnyDate - PreviousYearStart) \ 7 + 1
YearNum = Year(AnyDate) - 1
Case Else
ISOWeekNum = (AnyDate - ThisYearStart) \ 7 + 1
YearNum = Year(AnyDate)
End Select
If IsMissing(WhichFormat) Then
Exit Function
End If
If WhichFormat = 2 Then
ISOWeekNum = CInt(Format(Right(YearNum, 2), "00") & _
Format(ISOWeekNum, "00"))
End If
End Function
Public Function YearStart(WhichYear As Integer) As Date
Dim WeekDay As Integer
Dim NewYear As Date
NewYear = DateSerial(WhichYear, 1, 1)
WeekDay = (NewYear - 2) Mod 7
If WeekDay < 4 Then
YearStart = NewYear - WeekDay
Else
YearStart = NewYear - WeekDay + 7
End If
End Function
-----CODE ENDS HERE-----
You won't need ISOWeekNum and YearStart
HTH,
HAND
--
Amedee Van Gasse using XanaNews 1.17.3.1
If it has an "X" in the name, it must be Linux?
How To Ask Questions The Smart Way
How to Report Bugs Effectively
http://www.chiark.greenend.org.uk/~sgtatham/bugs.html
Only ask questions with yes/no answers if you want "yes" or "no" as the
answer.
http://homepages.tesco.net/~J.deBoynePollard/FGA/questions-with-yes-or-n
o-answers.html
