Sauvegarde sur clef usb

Bonjour MichD

Merci pour ton aide.

je voudrai garder le test de la clef,

si  cela fonctionne chez toi il devrait en être pareil chez moi.

J'ai modifier ma ligne 5 comme ceci,

Copie_répertoire_Source ThisWorkbook.path, "H2C_Ver_2"

ou H2C_Ver_2 est le nouveau nom du répertoire et du classeur

( pour essai ) sur disque dur et sur clef.

 La clef porte la lettre K, le répertoire est déja créé.

J'ai remplacé  Private Sub FermerProg_Click()

Par  Sub Macro2()  pour faire appel au module

 dans lequel est inscrite ta procédure

sans aucune modification (c'est peut être la qu'il y a problème ),

je lai inscrite et ni ai rien modifié.

Peux-tu me dire si c'est ce que tu voulais que je fasse ?

Merci encore

Peponne31

Moi, je ne comprends pas ton commentaire...

Ton répertoire sur ta clé est : "sav-prog" dans ta demande initiale.

Maintenant, il semble que ce soit "H2C_Ver_2", tu inscris dans la ligne de commande

le répertoire que tu veux. S'il n'existe pas, il sera créé automatiquement !

Le seul test effectué est à partir de mon environnement. Je n'ai qu'une clé de connecter... Si la clé est connectée, je n'éprouve aucun problème. À la limite, enlève cette section de code dans la procédure :

"Sub Copie_répertoire_Source(Répertoire As String, RepDestination)" qui va sauter le test... est-ce que la copie des fichiers s'effectue ?

'----------------------

Prêt = EstPret(LecteurDestination)

    If Prêt = False Then

        MsgBox "Le lecteur amovible n'est pas prêt."

        Exit Sub

    End If

Else

'----------------------

---

MichD

---

"Peponne31" a écrit dans le message de groupe de discussion : *** Adresse électronique supprimée pour cause de confidentialité ***...

Bonsoir à tous

Pour MichD.

J'ai bien fais ce que tu ma dit, mais j'ai le message

le lecteur amovible n'est pas prêt.

Dans variables à renseigner, doit-je remplacer (répertoire)

par l'adresse du répertoire à savoir, (H2C_Ver_2)

qui est l'adrese du réperoire dans le disque dur et dans la clef usb.

Ensuite le programme continue et ferme excel

au lieu d'attendre l'introduction de la clef.

Merci encore

Peponne31

Bonsoir à tous

Pour MichD.

J'ai bien fais ce que tu ma dit, mais j'ai le message

le lecteur amovible n'est pas prêt.

Dans variables à renseigner, doit-je remplacer (répertoire)

par l'adresse du répertoire à savoir, (H2C_Ver_2)

qui est l'adrese du réperoire dans le disque dur et dans la clef usb.

Ensuite le programme continue et ferme excel

au lieu d'attendre l'introduction de la clef.

Merci encore

Peponne31

Bonjour,

Copie ce qui suit dans un module standard

Et à la ligne 5 de ta procédure, tu inscris :

Copie_répertoire_Source ThisWorkbook.Path , "sav-prog"

Tous les fichiers dans le répertoire du fichier où il est enregistré

seront copiés exactement dans un répertoire ayant le même chemin

sur ta clé y compris les sous-répertoires et leurs fichiers si il y a en dans le répertoire.

N.B- Je n'ai pas pu faire plus long... ;-))

'---------------------------------------

Sub Copie_répertoire_Source(Répertoire As String, RepDestination)

Dim LecteurSource As String, Prêt As Boolean

Dim LecteurDestination As String

Dim Chemin As String

'***********Variables à renseigner*********

LecteurSource = Left(Répertoire, 3)

Chemin = Right(Répertoire, Len(Répertoire) - 3)

'*******************************************

LecteurDestination = RemovableDisk(LecteurSource)

If LecteurDestination <> "" Then

    Prêt = EstPret(LecteurDestination)

    If Prêt = False Then

        MsgBox "Le lecteur amovible n'est pas prêt."

        Exit Sub

    End If

Else

    MsgBox "Aucun disque amovible détecté."

    Exit Sub

End If

'Création du répertoire si nécessaire

Creer_Chemin LecteurDestination, LecteurDestination & RepDestination

DoEvents

'Copie des fichiers vers la destination

Commande = Environ("comspec") & " /c Xcopy /S/E/Y " & _

LecteurSource & Chemin & " " & LecteurDestination & RepDestination & ""

Shell Commande, 0

End Sub

Function RemovableDisk(MonLecteur As String)

strComputer = "."

Set objWMIService = GetObject("winmgmts:" _

    & "{impersonationLevel=impersonate}!\" & _

        strComputer & "\root\cimv2")

Set colDisks = objWMIService.ExecQuery _

    ("Select * from Win32_LogicalDisk")

For Each Objdisk In colDisks

    '2 constante numérique pour disque dur "removable"

    If Objdisk.DriveType = 2 Then

        RemovableDisk = Objdisk.Name & ""

        Exit Function

    End If

Next

End Function

Function EstPret(Lecteur As String)

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set colDrives = objFSO.Drives

For Each objdrive In colDrives

    If Lecteur = objdrive & "" Then

        If objdrive.IsReady = True Then

            EstPret = objdrive.IsReady

        End If

    End If

Next

End Function

Sub Creer_Chemin(Racine, Chemin As String)

Dim Commande As String

'Crée le chemin indiqué si les répertoires ne

'sont pas présents. N'écrase rien !

ChDrive Racine

Commande = Environ("comspec") & " /c mkdir " & Chemin

Shell Commande, 0

End Sub

'-------------------------------------------

---

MichD

---

"Peponne31" a écrit dans le message de groupe de discussion : *** Adresse électronique supprimée pour cause de confidentialité ***...

Bonjour,

Je voudrais modifier un bout de code pour sauvegarder un répertoire sur clef usb.

A la fermeture du classeur, le classeur s'enregistre dans C:"xxx" ou x égale nom du classeur, et je voudrais aussi sauvegarder le répertoire qui contient le classeur sur clef usb.

Voici ce que j'ai:

'                   ---------bouton quitter Excel-------------- Private Sub FermerProg_Click()

          Dim w

1             If Dir("K:\sav-prog", vbDirectory) <> "" Then

2                 Application.DisplayAlerts = False

3                 For Each w In Application.Workbooks

4                     w.Save '---------Sauvegarde le classeur sur l'ordi -------- 5                     w.SaveAs "K:\sav-prog" & w.Name '----Sauvegarde le classeur sur la clef de sauvegarde ---- 6                 Next

7                 Application.DisplayAlerts = True

8                 mywav6 ' ceci exécute la macro qui est dans le module 5

9                 Application.ScreenUpdating = True

10                Application.CommandBars.ActiveMenuBar.Enabled = True

11                Application.CommandBars("Formatting").Visible = True

12                Application.CommandBars("Standard").Visible = True

13                Application.DisplayFormulaBar = True

14                Application.DisplayScrollBars = True

15                ActiveSheet.Protect

16                Application.Quit

17                Exit Sub

18            Else

19                MsgBox "Vérifier que la clef soit bien en place"

20            End If

End Sub

je voudrais modifier la ligne 5 pour sauvegarder le répertoire et non le classeur.

Si quelq'un peut m'aider !!!

Merci par avance.

Peponne31