XL 2016 Sauvegarder un fichier sur clé USB

[scoubidou35]

Bonjour à tous,

J'ai un fichier excel sur mon PC et j'aimerai que lorsque je le ferme il me fasse un enregistrement des modifications sur le fichier sur le PC mais en plus qu'il me fasse une sauvegarde sur clé USB.
Avec l'option de vérifier si la clé est dispo et que si c'est pas le cas cela m'affiche un message pour me prévenir que la sauvegarde n'a pas eu lieu (puisque pas de clé USB) et que lorsque je la mets la sauvegarde peu se faire.

J'ai mis dans mon fichier test mon code (dans module1) qui enregistre bien les modifications apporté sur l'emplacement prévus dans mon PC mais je n'arrive pas à activer le reste du code pourtant je demande bien dans le code de vérifier si la clé en mise si c'est le cas alors on créé la sauvegarde du fichier. Et dans le cas contraire j'ai un message pour me prévenir que la clé n'a pas été trouvé et que dès lors que la mets et que je clique sur le bouton 'Recommencer' la sauvegarde se fait.
Le code s'éxécute avant la fermeture du fichier (cf. ThisWorkBook)

Mais le problème est que mon code ne fonctionne pas et je ne trouve pas la raison.

Je ne sais pas si mes explications sont claires mais je reste disponible pour tous renseignements si besoins.
Merci

 

[gbinforme]

Bonjour,
Tu devrais indenter ton code correctement car comme tu fais cela ne te facilite pas la tache et cela te permettrais de voir qu'il faut tester l'absence de clé en dehors de la boucle sur les disques.

 

[patricktoulon]

bonsoir
il ne fallait pas mettre la condition cle non trouvée dans la même boucle
(sans garantie ) ton code corrigé et indenté

Sub Sauvegarde_Sur_LecteurAmovible()
    Dim FSO As Object
    Dim Drv As Object
    Dim reponse As Long
    Dim trouvé As Boolean

    'Correspond au nom que vous avez préalablement attribué à votre clé.
    Const Cible As String = "Nom donnée à la clé USB"

    Set FSO = CreateObject("Scripting.FileSystemObject")

re:
    On Error Resume Next
    For Each Drv In FSO.Drives
        If Drv.DriveType = 1 Then
            If Drv.VolumeName = UCase(Cible) And Drv.IsReady Then
                ThisWorkbook.SaveCopyAs Drv.DriveLetter & ":\GardenManager\GardenManager v2.7.xlsm"
                trouvé = True
            Exit For 'pas la peine de tourner plus longtemps si trouvé
            End If
        End If
    Next

    If Not trouvé Then
        reponse = MsgBox("GardenManager n'a pas pu effectuer de sauvegarde." & vbCrLf & _
                         "Le lecteur amovible '" & Cible & "' n'a pas été trouvé." _
                       & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Chr(13) & Chr(10) _
                       & "Veuillez insérer la clé et cliquer sur 'Recommencer' ", vbRetryCancel, "INFORMATION GardenManager")
        If reponse = vbRetry Then GoTo re:
    End If

    If ThisWorkbook.Path <> "" Then
        ThisWorkbook.Save
    Else

        ThisWorkbook.SaveAs "C:\Users\Desktop\Bureau\MONFICHIERS.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    End If
End Sub

 

[scoubidou35]

Bonjour à tous,
Je vous remerci gbinforme et patricktoulon pour votre aide.
Et encore merci pour patricktoulon pour le code cela fonctionne comme je le recherchais.
Je pensais que je bouclais avec mon code mais je le faisais mal encore une chose d'apprise sur le VBA.

Merci encore à tous les deux et bon WE à tous