Discussion :

[amat-info]

meilleurs voeux 2011 a tout le monde
tout d'abord je remercie tout le monde qui participe a ce forum etant donnee que j'ai cree mon application 10 % de mon savoir et le reste c'est l'equipe merci encore
mon probleme aujourd'hui c'est comment faire pour une sauvegarde sur support
et une restauration d'une table de db merci d'avance

[js8bleu]

Merci et Bonne Année 2011 à toi également. Tu peux ajouter le composant Microsoft Common Dialog Control sur ton formulaire puis saisir (à peu près) le code suivant dans un bouton (cmdsaveusb par exemple) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub cmdsaveusb_Click()
Dim chemin As String
Dialog.ShowSave
chemin = Dialog.FileName
FileCopy "C:\monfichier.txt", chemin
End Sub

Enfin, je pense que tu peux le faire comme ça. Cependant FileCopy n'est pas la meilleure manière de copier car il ne gère pas si le fichier existe déjà dans la clé usb et/ou si le fichier est déjà ouvert.

Sinon tu peux utiliser l'API Copyfile mais je ne sais malheureusement pas comment l'employer.

Du courage.

Cordialement.

[iclic]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Option Explicit
 
Private Sub Command1_Click()
Dim fso
Dim TonChemin As String, CheminSurLaClé As String, Message As String
Dim réponse As Integer
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  CheminSurLaClé = "..."
  TonChemin = "..."
 
  Message = "Introduire la clé USB SECURITE pour copier vers " & CheminSurLaClé
  Do
     réponse = MsgBox(Message, 4161, "Sauvegarde")
     'bouton annuler
     If réponse = 2 Then Exit Do
     'pour vérifier si le dossier existe sur la clé
     If fso.folderexists(CheminSurLaClé) Then
           'pour vérifier si ton dossier et le fichier existe
           If fso.fileexists(TonChemin) Then
                 fso.CopyFile TonChemin, CheminSurLaClé
                 MsgBox ("copie réussie")
                 réponse = 2
           End If
     End If
     'pour le cas où 'TonChemin ou 'CheminSurLaClé ne serait pas correct
     Message = "La copie ne s'est pas effectuée"
  Loop Until réponse = 2
End Sub

[amat-info]

la proposition de JS8BLEU c'est ok ça marche
mais la proposition de ICLIC un message " permission refusee " est afficher

[l_autodidacte]

permission refusee

parce que tu as spécifié un chemin non valide : Tu essaies d'écraser un dossier par un fichier !!!!!!!!!!!!!

Dans CheminSurClé tu dois ajouter le séparateur de dossier à la fin par exemple CheminSurClé ="L:\ABC\ABX\" sinon ce dossier sera considéré comme étant le nom du fichier destination or c'est le nom d'un dossier existant et le code proposé par iclic marche très bien. Voici une autre variante du même code mais pour copier tous les fichiers du dossier source:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Command1_Click()
Dim fso
Dim SrcDir As String, DestDir As String, Message As String
Dim réponse As Integer
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  DestDir = "L:\ABC\ABX\"
  SrcDir = "C:\Temp\"
    Message = "Introduire la clé USB SECURITE pour copier vers " & DestDir
     réponse = MsgBox(Message, vbOKCancel, "Sauvegarde")
     If réponse = 2 Then Exit Sub
     If fso.FolderExists(DestDir) Then
           If fso.FolderExists(SrcDir) Then
                 fso.CopyFile SrcDir & "*.*", DestDir
                 MsgBox ("copie réussie")
           End If
     End If
End Sub

[amat-info]

ok ça marche mais lorsque je change de cle probleme et meme si le fichier existe
j'ai le msg " copie ne s'est pas effectuee"
voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Private Sub Command1_Click()
Dim fso
Dim TonChemin As String, CheminSurLaClé As String, Message As String
Dim réponse As Integer
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  CheminSurLaClé = "h:\abc\"
  TonChemin = "c:\caisse\money.mdb"
 
  Message = "Introduire la clé USB SECURITE pour copier vers " & CheminSurLaClé
  Do
     réponse = MsgBox(Message, 4161, "Sauvegarde")
     'bouton annuler
     If réponse = 2 Then Exit Do
     'pour vérifier si le dossier existe sur la clé
     If fso.folderexists(CheminSurLaClé) Then
         'pour vérifier si ton dossier et le fichier existe
           If fso.fileexists(TonChemin) Then
                 fso.CopyFile TonChemin, CheminSurLaClé
                 MsgBox ("   copie réussie  ")
                 réponse = 2
           End If
     End If
     'pour le cas où 'TonChemin ou 'CheminSurLaClé ne serait pas correct
     Message = "La copie ne s'est pas effectuée"
  Loop Until réponse = 2
End Sub

[ThierryAIM]

es-tu sûr que ta clé est toujours vu comme lecteur H: ?

[l_autodidacte]

Si ta clé change de lettre, tu peux te passer de spécifier celle-ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
38
39
40
41
42
43
44
45
46
Option Explicit
 
Private Sub Command1_Click()
Dim fso
Dim TonChemin As String, CheminSurLaClé As String, Message As String
Dim réponse As Integer
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  CheminSurLaClé = "\abc\"  ' ici on se passe de la racine du lecteur USB
  TonChemin = "c:\caisse\money.mdb"
 
  Message = "Introduire la clé USB SECURITE pour copier vers " & CheminSurLaClé
  If VerifierCleUSB = "" Then
     réponse = MsgBox(Message, 4161, "Sauvegarde")
     If réponse = 2 Then
        Exit Sub
     Else: GoTo 1
     End If
Else:   GoTo 1
End If
 
1:   CheminSurLaClé = VerifierCleUSB & CheminSurLaClé
     If fso.folderexists(CheminSurLaClé) Then
           If fso.fileexists(TonChemin) Then
                 fso.CopyFile TonChemin, CheminSurLaClé, True
                 MsgBox ("   copie réussie  ")
           Else:  MsgBox "La copie ne s'est pas effectuée"
           End If
     Else:  MsgBox "La copie ne s'est pas effectuée"
     End If
     Set fso = Nothing
End Sub
'===============
'Fonction de recherche de la lettre du lecteur USB par exemple H:
Function VerifierCleUSB() As String
   Dim drv, drvPath, fso
   Set fso = CreateObject("Scripting.FileSystemObject")
   For Each drv In fso.Drives
    If drv.DriveType = 1 And drv.IsReady Then
      'On récupère le premier lecteur USB disponible et on sort de la boucle
      drvPath = drv.Path
      If drvPath <> "" Then Exit For
    End If
  Next drv
  VerifierCleUSB = drvPath
End Function

[amat-info]

ok mon frere ça marche a merveille