Discussion :

[dalleau974]

bonjour j'ai l'erreur suivante lorsque j’essaie de copier un fichier 'erreur d'execution 52' nom ou numéro de fichier incorrect
j'utilise le code suivante et l'erreur apparait a l'avant dernier ligne.
quelqu'un aurai une idée pour regler se probleme?

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
Dim rst As New ADODB.Recordset
rst.Open "emplacement", CurrentProject.Connection, adOpenStatic, adLockReadOnly
rst.MoveFirst
dossier = Nz(rst!dossier)
' SELECTION MULTIPLE DE FICHIERS
 
  Dim fd As Office.FileDialog
  Dim varFichier As Variant
  Dim strListe As String
 
  ' Créer un objet FileDialog
  Set fd = Application.FileDialog(msoFileDialogOpen)
 
  ' Titre de la boîte de dialogue
  fd.Title = "Sélectionnez un ou plusieurs fichiers..."
 
  ' Autoriser la sélection multiple
  fd.AllowMultiSelect = True
 
  ' Définir les types de fichiers autorisés
  fd.Filters.Clear
  fd.Filters.Add "Tous les fichiers", "*.*"
 
  ' Présélectionner le 2ème type de fichier (images)
  fd.FilterIndex = 2
 
  ' Pas de nom par défaut
  fd.InitialFileName = ""
 
  ' Afficher la boîte de dialogue
  If fd.Show() Then
    ' Lister les chemins de tous les fichiers sélectionnés
    strListe = ""
    For Each varFichier In fd.SelectedItems
      strListe = strListe & varFichier & vbCrLf
 
    Next
 
    ' Afficher le résultat
    MsgBox "Vous avez sélectionné les fichiers suivants : " _
      & vbCrLf & strListe, vbInformation
 
End If
  Set fd = Nothing
  FileCopy strListe, dossier
end sub

cordialement

[jimbolion]

dalleau974,

Remettre les lignes commentées et vérifier que le dernier caractère de l'emplacement contient "\" dans la variable Dossier
La fonction copie exige un nom de fichier et pas de répertoire (la fonction ExtractFileName permet donc d'extraire le nom du fichier d'un chemin complet)

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
47
48
49
50
51
52
53
54
55
Function Copy_Fichier()
'Dim rst As New ADODB.Recordset
'rst.Open "emplacement", CurrentProject.Connection, adOpenStatic, adLockReadOnly
'rst.MoveFirst
 dossier = "C:\Temp\"
' SELECTION MULTIPLE DE FICHIERS
 
  Dim fd As Office.FileDialog
  Dim varFichier As Variant
  Dim strListe As String
 
  ' Créer un objet FileDialog
  Set fd = Application.FileDialog(msoFileDialogOpen)
 
  ' Titre de la boîte de dialogue
  fd.Title = "Sélectionnez un ou plusieurs fichiers..."
 
  ' Autoriser la sélection multiple
  fd.AllowMultiSelect = True
 
  ' Définir les types de fichiers autorisés
  fd.Filters.Clear
  fd.Filters.Add "Tous les fichiers", "*.*"
 
  ' Présélectionner le 2ème type de fichier (images)
  fd.FilterIndex = 2
 
  ' Pas de nom par défaut
  fd.InitialFileName = ""
 
  ' Afficher la boîte de dialogue
  If fd.Show() Then
    ' Lister les chemins de tous les fichiers sélectionnés
    strListe = ""
    For Each varFichier In fd.SelectedItems
      strListe = strListe & varFichier & vbCrLf
      Destfichier = dossier & ExtractFileName(varFichier)
      FileCopy varFichier, Destfichier
    Next
 
    ' Afficher le résultat
    MsgBox "Vous avez sélectionné les fichiers suivants : " _
      & vbCrLf & strListe, vbInformation
 
End If
  Set fd = Nothing
  '
End Function
Public Function ExtractFileName(ByVal sFullPath As String) As String
    If InStr(sFullPath, "\") = 0 Or Right(sFullPath, 1) = "\" Then
        ExtractFileName = ""
        Exit Function
    End If
    ExtractFileName = Mid(sFullPath, InStrRev(sFullPath, "\") + 1)
End Function

JimBoLion

[dalleau974]

dalleau974,

Remettre les lignes commentées et vérifier que le dernier caractère de l'emplacement contient "\" dans la variable Dossier
La fonction copie exige un nom de fichier et pas de répertoire (la fonction ExtractFileName permet donc d'extraire le nom du fichier d'un chemin complet)

Merci de ton aide j'ai remodifier ton code pour qu'il fonctionne pour moi

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
47
48
49
50
51
52
53
54
55
Private Sub Commande220_Click()
'Dim rst As New ADODB.Recordset
'rst.Open "emplacement", CurrentProject.Connection, adOpenStatic, adLockReadOnly
'rst.MoveFirst
 dossier = "C:\temp\"
' SELECTION MULTIPLE DE FICHIERS
 
  Dim fd As Office.FileDialog
  Dim varFichier As Variant
  Dim strListe As String
 
  ' Créer un objet FileDialog
  Set fd = Application.FileDialog(msoFileDialogOpen)
 
  ' Titre de la boîte de dialogue
  fd.Title = "Sélectionnez un ou plusieurs fichiers..."
 
  ' Autoriser la sélection multiple
  fd.AllowMultiSelect = True
 
  ' Définir les types de fichiers autorisés
  fd.Filters.Clear
  fd.Filters.Add "Tous les fichiers", "*.*"
 
  ' Présélectionner le 2ème type de fichier (images)
  fd.FilterIndex = 2
 
  ' Pas de nom par défaut
  fd.InitialFileName = ""
 
  ' Afficher la boîte de dialogue
  If fd.Show() Then
    ' Lister les chemins de tous les fichiers sélectionnés
    strListe = ""
    For Each varFichier In fd.SelectedItems
      strListe = strListe & varFichier & vbCrLf
      Destfichier = dossier & ExtractFileName(varFichier)
      FileCopy varFichier, Destfichier
    Next
 
    ' Afficher le résultat
    MsgBox "Vous avez sélectionné les fichiers suivants : " _
      & vbCrLf & strListe, vbInformation
 
End If
  Set fd = Nothing
  '
End Sub
Public Function ExtractFileName(ByVal sFullPath As String) As String
    If InStr(sFullPath, "\") = 0 Or Right(sFullPath, 1) = "\" Then
        ExtractFileName = ""
        Exit Function
    End If
    ExtractFileName = Mid(sFullPath, InStrRev(sFullPath, "\") + 1)
End Function

mais dossier est un chemin variable donc je l'ai modifier pour qu'il point sur le champs d'une table ou l'adresse du dossier y est inscrit.

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
47
48
49
50
51
52
53
54
55
Private Sub Commande220_Click()
Dim rst As New ADODB.Recordset
rst.Open "emplacement", CurrentProject.Connection, adOpenStatic, adLockReadOnly
rst.MoveFirst
 dossier = Nz(rst!dossier)
' SELECTION MULTIPLE DE FICHIERS
 
  Dim fd As Office.FileDialog
  Dim varFichier As Variant
  Dim strListe As String
 
  ' Créer un objet FileDialog
  Set fd = Application.FileDialog(msoFileDialogOpen)
 
  ' Titre de la boîte de dialogue
  fd.Title = "Sélectionnez un ou plusieurs fichiers..."
 
  ' Autoriser la sélection multiple
  fd.AllowMultiSelect = True
 
  ' Définir les types de fichiers autorisés
  fd.Filters.Clear
  fd.Filters.Add "Tous les fichiers", "*.*"
 
  ' Présélectionner le 2ème type de fichier (images)
  fd.FilterIndex = 2
 
  ' Pas de nom par défaut
  fd.InitialFileName = ""
 
  ' Afficher la boîte de dialogue
  If fd.Show() Then
    ' Lister les chemins de tous les fichiers sélectionnés
    strListe = ""
    For Each varFichier In fd.SelectedItems
      strListe = strListe & varFichier & vbCrLf
      Destfichier = dossier & ExtractFileName(varFichier)
      FileCopy varFichier, Destfichier
    Next
 
    ' Afficher le résultat
    MsgBox "Vous avez sélectionné les fichiers suivants : " _
      & vbCrLf & strListe, vbInformation
 
End If
  Set fd = Nothing
  '
End Sub
Public Function ExtractFileName(ByVal sFullPath As String) As String
    If InStr(sFullPath, "\") = 0 Or Right(sFullPath, 1) = "\" Then
        ExtractFileName = ""
        Exit Function
    End If
    ExtractFileName = Mid(sFullPath, InStrRev(sFullPath, "\") + 1)
End Function

merci grâce a toi j'ai pu réglé le problème

Cordialement