VBA Macro pour enregistrer un fichier excel vers un autre emplacement de sauvegarde

Je suis en train de créer une Macro qui exécute sur fermer ou sur enregistrer pour sauvegarder le fichier à un emplacement différent.
Au moment de la Macro que j'ai utilisé est:

Private Sub Workbook_BeforeClose(Cancel As Boolean)  
'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  
    'Saves the current file to a backup folder and the default folder  
    'Note that any backup is overwritten  
    Application.DisplayAlerts = False  
    ActiveWorkbook.SaveCopyAs Filename:="T:\TEC_SERV\Backup file folder - DO NOT DELETE\" & _ 
    ActiveWorkbook.Name  
    ActiveWorkbook.Save  
    Application.DisplayAlerts = True  
End Sub

Cela crée une sauvegarde du fichier ok la première fois, mais si cela est jugé à nouveau je reçois:

Erreur D'Exécution '1004';
Microsoft Office Excel ne peut pas accéder au fichier 'T:\TEC_SERV\Backup dossier - NE PAS SUPPRIMER\Macros de Test de la Feuille.xlsm. Il y a plusieurs raisons possibles:
Le nom de fichier ou chemin d'accès n'existe
Le fichier est utilisé par un autre programme
Le classeur que vous tentez d'enregistrer le même nom qu'un...

Je sais que le chemin d'accès est correct, je sais aussi que le fichier n'est pas ouvert n'importe où ailleurs. Le classeur a le même nom que celui que je suis en train d'économiser plus mais il faut juste remplacer.

Toute aide serait grandement appréciée.

Je ne peux pas reproduire ce comportement (au moins, pas avec Excel 2002). Fonctionne très bien. Êtes-vous sûr que vous n'avez pas de sauvegarde de votre fichier ouvrir? Et savez-vous que lorsque vous ouvrez votre fichier de sauvegarde, il va essayer de faire un backup de lui-même dans le dossier de sauvegarde?
Oui je suis au courant de cela, c'est l'un des problèmes avec la commande de fermeture qui m'a fait penser à aller à la commande enregistrer. Cela permettrait de lever le problème de la sauvegarde, il ne serait pas sauvé. Le fichier de sauvegarde est certainement pas l'ouvrir. C'est un peu d'un jeu de puzzle. J'ai aussi à l'origine l'exécution de la commande à partir d'un bouton personnalisé dans la barre d'outils, mais a eu des problèmes avec des gens d'oublier de cliquer dessus. D'où la proximité de l'événement d'être remplacé.

OriginalL'auteur Joe Taylor | 2010-05-14

  1. 5

    J'ai modifié le code pour cela:

    Sub BUandSave2()
'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Saves the current file to a backup folder and the default folder
'Note that any backup is overwritten
Dim MyDate
MyDate = Date    ' MyDate contains the current system date.
Dim MyTime
MyTime = Time    ' Return current system time.
Dim TestStr As String
TestStr = Format(MyTime, "hh.mm.ss")
Dim Test1Str As String
Test1Str = Format(MyDate, "DD-MM-YYYY")

Application.DisplayAlerts = False
'
Application.Run ("SaveFile")
'
ActiveWorkbook.SaveCopyAs Filename:="T:\TEC_SERV\Backup Test\" & Test1Str & " " & TestStr & " " & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub

    il fonctionne maintenant très bien. Il doit y avoir quelque chose sur le réseau de l'université qui empêche l'original de l'exécution. J'ai eu aucun problème avec elle à la maison.

    venant d'erreur dans l'Application.Run ("SaveFile")
    Merci, j'ai commencé à utiliser cette!

    OriginalL'auteur Joe Taylor

  2. 1

    J'ai essayé le code écrit par vous et j'ai trouvé le code a fonctionné, mais quand j'ai ouvert le fichier de sauvegarde j'ai eu le même message d'erreur que vous avez obtenu.

    Donc je pense que vous devez avoir ouvert le fichier de sauvegarde lorsque vous avez obtenu l'erreur.

    J'ai écrit un code pour vous aider avec cette erreur:

    If ActiveWorkbook.Path = "D:\MOVIES\excel test\Backup" Then
    Exit Sub
Else
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveCopyAs Filename:="D:\MOVIES\excel test\Backup\" & _
    ActiveWorkbook.Name
    ActiveWorkbook.Save
    Application.DisplayAlerts = True

    Je ne pense pas qu'il y avait quelque chose de mal avec le réseau de l'université.

    Si vous n'êtes pas satisfait de la réponse ou avez un doute, veuillez m'envoyer un email à [email protected]

    Ce qui concerne

    Kishlay Mishra

    OriginalL'auteur user2279080

  3. 0

    Juste pour compléter joe et kishlaymshr excellent code pour plus de clarté, merci!:

    Sub AutoBackup()

    If ActiveWorkbook.Path = "F:\TEMP\" Then

        Exit Sub

    Else

        Dim MyDate
        MyDate = Date    ' MyDate contains the current system date.
        Dim MyTime
        MyTime = Time    ' Return current system time.
        Dim TestStr As String
        TestStr = Format(MyTime, "hh.mm.ss")
        Dim Test1Str As String
        Test1Str = Format(MyDate, "DD-MM-YYYY")
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveCopyAs Filename:="F:\TEMP\" & _
           Test1Str & "-" & TestStr & "-" & ActiveWorkbook.Name
        ActiveWorkbook.Save
        Application.DisplayAlerts = True
    End If

End Sub

    OriginalL'auteur Riaz Khan