enregistrer une copie sur une clé usb

Version imprimable

18/09/2016, 11h49
schumi22000

enregistrer une copie sur une clé usb
bonjour à tous,

J'effectue un enregistrement après chaque macro de mon classeur, je fais également une copie de sécurité sur un clé usb.

voici le code que j'utilise pour la copie :
Code:

1 2 3 Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="E:\copy.xlsm" ' mettre un répertoire Application.DisplayAlerts = True
Mon soucis est que lorsque la clé n'est pas connecté et si elle est connecté sur un autre emplacement que E cela fait planter le code.

si quelqu'un a déjà eu ce soucis je suis preneur d'infos car je suis totalement novice :)
18/09/2016, 13h43
kiki29

1 pièce(s) jointe(s)

Salut, voir ici et adapter à ton contexte.
18/09/2016, 13h45
unparia

Bonjour
Je ne comprends pas que l'on puisse poser une telle question.
C'est à l'utilisateur, qu'il appartient de savoir ce qu'il fait et de décider du support de sauvegarde.
A s'amuser à se substituer à lui, y compris en s'assurant de ne choisir qu'un support externe (sur clé USB) n'aurait en effet aucun sens, dans la mesure où plusieurs clés USB (utilisées) comme support, pourraient être présentes sur une machine.
Sauf à pouvoir, bien évidemment, identifier la clé USB (par son N°, le nom d'un fichier "unique" à sa racine, etc ...)

Bonjour

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub test()
disck = D_USB 'si tu a qu'une seul cle de pluguée
'disck = D_USB("cleperso")  'si tu a plusieurs cle de pluguée il faut spécifié le nom
Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=disck & "copy.xlsm" ' mettre un répertoire
    Application.DisplayAlerts = True
End Sub
 
Function D_USB(Optional sname As String = "")
Dim FSO As Object, disque As Object,lettre as string
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each disque In FSO.Drives
If disque.DriveType = 1 Then
lettre = disque.driveletter
If sname <> "" And disque.volumename = sname Then lettre = disque.driveletter: Exit For
End If
Next
D_USB = lettre & ":\"
End Function

regarde bien les deux choix possibles dans test

18/09/2016, 14h03
schumi22000

En réalité, je suis étudiant, et j'ai realisé ce programme afin de gagner du temps au sein de mon école.
Nous réalisons le remplissage de l'USERFORM sur un PC connecté au réseau et par plusieurs personnes.
on travaille toujours avec la même clé usb pour sauvegarder certaines data, je souhaiterais donc effectuer une copie du fichier enregistré sur le réseau sur cette clé USB.
En effet, savoir si elle est toujours branché sur le meme " lecteur" ( D,E,F ...) est probablement difficile ( en tout cas pour moi ) mais s'il est possible de la retrouver par son nom dans ce cas je pourrais dans le cas où elle est branché effectuer une copy.

j'espère avoir été suffisament claire, c'est assez difficile pour moi étant totalement novice dans la programmation VBA ( et n'ayant aucune connaissance dans d'autres languages ...)
18/09/2016, 14h06
patricktoulon

re

je viens de te donner la réponse !!

Merci patricktoulon,

Je répondais à unparia et ta réponse est arrivé juste pendant.

En effet j'ai vu ton code, je viens de l'intégrer, mais il ne fonctionne pas.
j'ai tenter un simple copier coller de ton code, et j'ai également tenté de faire appeler la fonction " test" lors du clique sur le bouton.

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
 
Private Sub CommandButton1_Click()
'
'
'
'
'
'
'
'
Call test
    Sheets("LISTE DE TIR").Protect , AllowSorting:=True, AllowFiltering:=True
    ActiveWorkbook.Save
 
End Sub
 
' permet de faire une auto copy du classeur sur un autre disque ou cle usb
Sub test()
disck = D_USB("CLE PIERRE") 'disck = D_USB("cleperso")  'si tu a plusieurs cle de pluguée il faut spécifié le nom
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=disck & "copy.xlsm" ' mettre un répertoire
    Application.DisplayAlerts = True
End Sub
 
Function D_USB(Optional sname As String = "")
Dim FSO As Object, disque As Object, lettre As String
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each disque In FSO.Drives
If disque.DriveType = 1 Then
lettre = disque.driveletter
If sname <> "" And disque.volumename = sname Then lettre = disque.driveletter: Exit For
End If
Next
D_USB = lettre & ":\"
End Function

18/09/2016, 16h12
Marc-L

Bonjour, bonjour !

Avant d'ouvrir une discussion sur un forum, commencer par effectuer une recherche sur le net ‼

Comme déjà publié, la recherche d'un disque peut être effectuée soit sur le nom du volume

http://perso.numericable.fr/mpl/pic/FindVolume.gif

soit par le numéro de série du disque :

http://perso.numericable.fr/mpl/pic/FindSerial.gif

Voilà, voilà !

_________________________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

_________________________________________________________________________________________________________
Je suis Paris, Nice, Bruxelles, Charlie, …