Attribute VB_Name = "Module1"
Private Function AikaLeimaNyt() As String
'AikaS-muuttujaan lisätään ensin päivämäärän osat (rivit 2-4).
'Tiettynä helmikuisena päivänä AikaS-muuttujan arvo rivin 4 suorituksen jälkeen voisi olla vaikka "20070220_141501".
'Kannattaa huomata, että näillä koodiriveillä voitaisiin hakea aivan yhtä hyvin pelkkä päivämäärä (Date) koneen kalenterista.
'Rivillä 5 lisätään erotinmerkki aikaleimaan ja sitten AikaS-muuttujaan asetetaan kellonaikaa vastaavat arvot (rivit 6-8).
'Lopulta AikaS-muuttujan arvo asetetaan funktion vastaukseksi.
'Tällöin funktiota kutsuva aliohjelma saa ehdotetun tiedostonimen funktion vastauksena.
'Tässä esimerkissä on käytetty Format-funktiota päivämäärän osien muotoilemiseen.
'Aivan yhtä hyvin muotoilussa olisi voitu käyttää ehtolausetta.
'Ajatuksena olisi tällöin ollut se, että jos esimerkiksi nykyinen kuukausi on välillä 1-9,
'  AikaS-muuttujaan lisätään ensin nolla ja vasta sitten kuukauden numero.
'Jos ehtolause ei toteutuisi, kuukauden numero olisi välillä 10-12.
'Tässä tapauksessa kuukauden numero lisättäisiin AikaS-muuttujaan sellaisenaan.
'Myös päivä ja kellonajan osat voitaisiin käsitellä samalla tavalla.
1  Dim AikaS As String
2  AikaS = Year(Now)
3  AikaS = AikaS & Format(Month(Now), "00")
4  AikaS = AikaS & Format(Day(Now), "00")
5  AikaS = AikaS & "_"
6  AikaS = AikaS & Format(Hour(Now), "00")
7  AikaS = AikaS & Format(Minute(Now), "00")
8  AikaS = AikaS & Format(Second(Now), "00")
9  AikaLeimaNyt = AikaS
End Function

Sub TestaaAikaLeimaNyt()
  MsgBox AikaLeimaNyt
End Sub

Private Function TallennaAikaleimalla(ByVal Kansio As String) As String
'Rivillä 2 kutsutaan AikaLeimaNyt-funktiota ja otetaan funktion palauttama vastaus talteen TiedNimi-muuttujaan.
'Tässä vaiheessa tallennettavan varmuuskopiotiedoston sijainti on kokonaisuudessaan tiedossa.
'Tiedosto voidaan siis tallentaa, ja tämä tapahtuu koodin rivilä 3.
'Huomaa, että tallennuksessa on käytetty SaveCopyAs-metodia.
'Tämä luo tiedostosta kopion, mutta ei tallenna markotyökirjaa eikä esimerkiksi muuta oletuskansiota.
'Tiedoston nimi rakennetaan muuttujista Kansio ja TiedNimi sekä päätteestä xlsx.
'1  Dim TiedNimi As String
2  TiedNimi = AikaLeimaNyt
3  ActiveWorkbook.SaveCopyAs Kansio & TiedNimi & ".xlsx"
4  TallennaAikaleimalla = TiedNimi
End Function

Private Function PoistaVanhatTiedostot(ByVal Kansio As String) As Long
'Vanhojen tiedostojen poito tehdään Dir-funkiolla toteutetussa silmukassa (rivit 4-10).
'Rivillä 3 pyydetään Dir-funktiota palauttamaan ensimmäisen löydetyn Excel-työkirjan nimi työkansiossa.
'Jos tiedosto löytyy, tiedetään kansioissa olevan ainakin yksi tarkistettava tiedosto.
'Koska tiedoston tallennushetken informaatio on tiedoston nimessä itsessään,
' ajan vertailu nykyhetkeen on helppoa.
'DateSerial-funktiolle annetaan parametrina tiedoston nimen alusta vuosi,
' kuukausi ja päivä (rivi 5), ja funktio palauttaa näistä rakennetun päivämäärän päivämäärämuodossa.
'Parametri muutetaan merkkijonomuodosta kokonaisluvuiksi käyttäen CInt-konvertiofunktiota.
'Jos tiedoston nimestä johdettu päivämäärä on yli viikon vanha, tiedosto poistetaan.
'Tämä tehdään käyttämällä Kill-valmisfunktiota.
'Huomaa, että tämä poistotekniikka ei tarkista tiedoston luonnin kellonaikaa.
'Poistossa otetaan huomioon ainoastaan tiedoston luontipäivä.
'Tämän vuoksi poistotapahtumassa verrataan tiedoston luontipäivää koneen kalenterin nykyiseen päivään,
' ja yhdellä poistokerralla poistetaan kaikki yhden päivän tiedostot.
1   Dim SR As String
2   Dim TmpL As Long
3   SR = Dir(Kansio & "*.xls")
4   Do While SR <> ""
5     If DateSerial(CInt(Left(SR, 4)), CInt(Mid(SR, 5, 2)), CInt(Mid(SR, 7, 2))) < Date - 7 Then
6       Kill Kansio & SR
7       TmpL = TmpL + 1
8     End If
9     SR = Dir
10  Loop
11  PoistaVanhatTiedostot = TmpL
End Function

Public Sub TallennaMain()
'Rivillä 4 haetaan työkansio työkirjan määrätystä solusta.
'Kansion noutamisessa olisi tietysti monia vaihtoehtoja,
'  kulloisenkin tilanteen määrittelyjen mukaisesti.
'Tämän kansion perusteella kutsutaan funktioita TallennaAikaleimalla ja PoistaVanhatTiedostot.
'Näiden palauttamat arvot otetaan talteen parametreihin TNimi ja TLkm (rivit 5 ja 6),
'  jotta käyttäjälle voidaan näyttää tarvittavat tiedot tallennuksen ja poiston onnistumisesta (rivi 7).
   Dim Kansio As String
   Dim TNimi As String
   Dim TLkm As Long
On Error GoTo Virhe
   If IsEmpty(Sheets("Asetukset").Range("B1").Value) Then
4    Kansio = Sheets("Asetukset").Range("B1").Value
5    TNimi = TallennaAikaleimalla(Kansio)
6    TLkm = PoistaVanhatTiedostot(Kansio)
7    MsgBox "Varmuuskopio tallennettu : " & Kansio & TNimi & Chr(10) & "Vanhoja tiedostoja poistettu " & TLkm & " kpl."
   Else
     MsgBox "Kansiotieto puuttuu Asetukset-taulukkosivun solusta B1"
   End If
   Exit Sub
Virhe:
  If Err.Number = 9 Then
    MsgBox "Virhe. Tarkista, että työkirjassa on Asetukset-taulukkosivu ja siinä solussa B1 oikea kansiorakenne."
  Else
    MsgBox "Virhenumero: " & Err.Number & " Virheselite: " & Err.Description
  End If
End Sub