Automatisation d'une macro existante
Bonjour,
Je voudrais automatiser une macro déjà existante dans mon fichier excel qui sauvegarde ce même fichier.
Comment la lancer automatiquement à heure et date fixe ?
Merci.
Voici le texte :
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
| Sub XLBackup()
'Maken van backup over netwerk
'Uitgevoerd m.b.v. Xcopy commando in DOS shell omdat VBA's eigen copyfile commando niet werkt op geopende bestanden
Dim command, Backup_folder, Kopieerparam, Foutbericht As String
'MsgBox "XLbackup"
OldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Copie du backup ..."
'Eerst saven
ActiveWorkbook.Save
'Dan backupkopie maken
Backup_folder = "G:\FABREPORT\Asset Utilisation\Back_up"
'Backup_folder = "D:\_arie\"
Kopieerparam = "/F/C"
command = "Xcopy " & Chr(34) & ActiveWorkbook.Path & "\" & ActiveWorkbook.Name & Chr(34) & " " & Chr(34) & Backup_folder & Chr(34) & " " & Kopieerparam
Set wsShell = CreateObject("wscript.shell")
Set proc = wsShell.Exec(command)
Do While proc.status = 0
Application.Wait (Now + TimeValue("0:00:01")) 'Wait until command is completely executed
Loop
If proc.ExitCode <> 0 Then
'Use proc.ExitCode to check for returned %errorlevel%
Foutbericht = "Tijdens het kopiëren naar backupbestand is een fout opgetreden:" & Chr(13) _
& "StdOut=" & proc.StdOut.ReadAll() & Chr(13) & Chr(10) & " ExitCode=" & proc.ExitCode
MsgBox Foutbericht, vbOKOnly + vbCritical
End If
Set wsShell = Nothing
Set proc = Nothing
Application.StatusBar = False
Application.DisplayStatusBar = OldStatusBar
StartTimer
End Sub |