Automatisch opslaan finetuning (VBA)

Status
Niet open voor verdere reacties.
H

HHD

Gebruiker
Lid geworden
12 apr 2016
Berichten
23
Goedemorgen,

In een bestand (Gegevens.xlsm) heb ik VBA code opgenomen om van dat bestand na iedere 5 minuten automatisch een kopie op te slaan in een andere map, dit ziet er zo uit:

In 'ThisWorkbook':
Code: 
Private Sub Workbook_Open()
'Automatisch opslaan
Application.OnTime Now + TimeValue("00:05:00"), "SaveThis"
End sub

In 'Module1':
Code: 
Sub SaveThis()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = False
        ThisWorkbook.SaveCopyAs "N:\Back-ups\" & _
                        Format(Now, "dd-mm-yyyy hh.mm") & " " & _
                          Application.UserName & " " & _
                          ActiveWorkbook.Name
Application.OnTime Now + TimeValue("00:05:00"), "SaveThis"
End Sub

De problemen die dit met zich mee brengt zijn:
1. Wanneer ik meerdere Excelbestanden geopend heb, maakt het een backup van alle geopende bestanden op, niet alleen Gegevens.xlsm. -> Ik wil alleen Gegevens.xlsm backuppen!
2. Na het afsluiten van Gegevens.xlsm (en het nog open hebben van een ander Excel bestand), opent na 5 minuten vanzelf Gegevens.xlsm weer. -> Na afsluiten wil ik niet dat het bestand automatisch weer geopend word.

Welke aanpassingen in de code moet ik doen om deze twee issues op te lossen? Suggesties?

Hartelijke groet,
Henri
 
De eerste issue is hoogst merkwaardig en zou niet mogen gebeuren. De tweede is op te losen door de nieuwe tijd waarmee de volgende saveThis is ingesteld te onthouden, dan kan je hem voor sluiten van de werkmap annuleren:
Code: 
Option Explicit

Dim NextTime As Date

Sub SaveThis()
    Application.DisplayAlerts = False
    ThisWorkbook.Save
    Application.DisplayAlerts = False
    ThisWorkbook.SaveCopyAs "N:\Back-ups\" & _
                            Format(Now, "dd-mm-yyyy hh.mm") & " " & _
                            Application.UserName & " " & _
                            ActiveWorkbook.Name
    NextTime = Now + TimeValue("00:05:00")
    Application.OnTime NextTime, "SaveThis"
End Sub

Sub CancelNextSave()
    On Error Resume Next
    Application.OnTime EarliestTime:=NextTime, Procedure:="SaveThis", schedule:=False
End Sub
In ThisWorkbook:
Code: 
Option Explicit

Dim Closing As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Closing = True
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
    If Closing Then CancelNextSave
End Sub
 
Je moet de timer stoppen bij het sluiten van je bestand.
in ThisWorkbook module
Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    Application.OnTime Now + TimeValue("00:00:30"), "SaveThis", , False 
End Sub
Voor the Save module
Code: 
Sub SaveThis()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = False
       [COLOR="#FF0000"] Workbooks("Gegevens.xlsm ")[/COLOR].SaveCopyAs "N:\Back-ups\" & _
                        Format(Now, "dd-mm-yyyy hh.mm") & " " & _
                          Application.UserName & " " & _
                          ActiveWorkbook.Name
Application.OnTime Now + TimeValue("00:05:00"), "SaveThis"
End Sub
 
@gast0660: dat werkt niet, je moet EXACT dezelfde tijd hebben om de ontime te kunnen annuleren, zie mijn post.
Ook moet je rekening houden met mensen die het sluiten annuleren en dan dus je geschedulede macro mogelijk ook. Vandaar mijn methode met BeforeCLose en DeActivate
 
Laatst bewerkt:
Bedankt voor de reacties alvast, ik ga het even uitproberen.
Nog wel even een aanvulling, ik kom er net achter dat punt 1 niet helemaal juist is.

1. Wanneer ik meerdere Excelbestanden geopend heb, maakt het een backup van alle geopende bestanden op, niet alleen Gegevens.xlsm. -> Ik wil alleen Gegevens.xlsm backuppen!
Klik om te vergroten...

Alleen de bestandsnaam is onjuist, niet de inhoud van de backup. De inhoud van de backup is wel gevuld met dezelfde gegevens als in Gegevens.xlsm maar is genoemd naar het excelbestand dat op het moment van opslaan actief is.
Hoe kan ik dit oplossen? Denk dat het aan het stukje 'ActiveWorkbook.Name' ligt maar weet niet hoe dit te ondervangen...
 
Laatst bewerkt:
AHA! Verander dit:
Code: 
Application.DisplayAlerts = False
        Workbooks("Gegevens.xlsm ").SaveCopyAs "N:\Back-ups\" & _
                        Format(Now, "dd-mm-yyyy hh.mm") & " " & _
                          Application.UserName & " " & _
                          ActiveWorkbook.Name
in
Code: 
Application.DisplayAlerts = False
        Workbooks("Gegevens.xlsm ").SaveCopyAs "N:\Back-ups\" & _
                        Format(Now, "dd-mm-yyyy hh.mm") & " " & _
                          Application.UserName & " " & _
                          ThisWorkbook.Name
 
jkpieterse zei:
AHA! Verander dit:
Code: 
Application.DisplayAlerts = False
        Workbooks("Gegevens.xlsm ").SaveCopyAs "N:\Back-ups\" & _
                        Format(Now, "dd-mm-yyyy hh.mm") & " " & _
                          Application.UserName & " " & _
                          ActiveWorkbook.Name
in
Code: 
Application.DisplayAlerts = False
        Workbooks("Gegevens.xlsm ").SaveCopyAs "N:\Back-ups\" & _
                        Format(Now, "dd-mm-yyyy hh.mm") & " " & _
                          Application.UserName & " " & _
                          ThisWorkbook.Name
Klik om te vergroten...

Dit lost dat probleem op, super bedankt!

Blijft alleen vraag probleem 2 nog bestaan;
2. Na het afsluiten van Gegevens.xlsm (en het nog open hebben van een ander Excel bestand), opent na 5 minuten vanzelf Gegevens.xlsm weer. -> Na afsluiten wil ik niet dat het bestand automatisch weer geopend word.
Klik om te vergroten...
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan