[VBA] Erreur avec un FSO.CopyFolder limitation dans les longueurs de chemins ?
24 réponses
HD
Bonjour,
Pour copier l'ensemble d'un répertoire j'utilise la méthode avec
FileSystemObject
Cela a bien fonctionné... sauf que.... dernièrement, les utilisateurs de ma
macro m'ont montré que je n'ai plus l'ensemble du répertoire de copier mais
seulement une partie de celui ci !!!
--------------
Dim RepDest As String 'Rép.de destination
Dim RepSource As String 'Rép.Matrice à copier
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFolder RepSource, RepDest
--------------
Le problème semble lié à seulement certains répertoires de destination... et
cela semble bien lié à la longueur du chemin complet.
Exemple, avec un RepDest = "H:\CAC\1.ASSOCIATIONS\Autres\test" il n'y a pas
de souci... mais avec un RepDest = "H:\CAC\1.ASSOCIATIONS\SECT SOCIAL
INSERTION ACTIVITE ECO\test" j'ai alors un code erreur 76 avec une
description "Chemin d'accès introuvable" sur la ligne:
FSO.CopyFolder RepSource, RepDest
Le dernier fichier copier de la source à la destination est
"H:\CAC\1.ASSOCIATIONS\SECT SOCIAL INSERTION ACTIVITE ECO\test\10 DTA\17
Dossier de contrôle CAC\17.10 Communication avec le client\17.10.2
Echantillonnage de la population à tester pour les
circularisation\Echantillonage de la pop à tester circu frs.xls" (chemin de
253 caractères). Le dernier fichier qui aurait dû être copier mais qui ne
l'a pas été est "H:\CAC\1.ASSOCIATIONS\SECT SOCIAL INSERTION ACTIVITE
ECO\test\10 DTA\17 Dossier de contrôle CAC\17.10 Communication avec le
client\17.10.2 Echantillonnage de la population à tester pour les
circularisation\Matrice échantillonage de la pop à tester circu client.xls"
(chemin de 264 caractères).
Y'a-t-il donc une limitation dans les longueurs de chemin dû à FSO ? dû au
type de donnée String ? Et comment y remédier (sans pour autant limiter la
longueur de ces chemins) ?
Pour précision, je suis sous Windows XP Pro avec un Excel 2007.
"HD" <hd@anti.spam.fr> a écrit dans le message de groupe de discussion : i5lqtq$mn9$1@saria.nerim.net...
Un lecteur virtuel créer via la commande SUBST pourrait donc être la
solution ?
Mais cette commande est elle compatible avec Windows 7 ?
"HD" <hd@anti.spam.fr> a écrit dans le message de groupe de discussion : i5lqtq$mn9$1@saria.nerim.net...
Un lecteur virtuel créer via la commande SUBST pourrait donc être la
solution ?
Mais cette commande est elle compatible avec Windows 7 ?
"HD" a écrit dans le message de groupe de discussion : i5lqtq$mn9$ Un lecteur virtuel créer via la commande SUBST pourrait donc être la solution ?
Mais cette commande est elle compatible avec Windows 7 ?
-- @+ HD
michdenis
Voici une procédure complète... tu as 3 variables à définir dans la procédure Test.
Procédure copiant tous les fichiers et sous-répertoires et leurs fichiers respectifs du chemin source spécifié vers le chemin du répertoire destination spécifié.
Variables et API dans le haut du module Standard. Reste à tester si les noms très longs passent... Cela devrait accepter des chemins et noms de fichier jusqu'à 32768 caractères.
IMPORTANT : Ceci écrase tout dans le répertoire de destination sans préavis.
Option Explicit Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type
Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * 260 cAlternate As String * 14 End Type
Private Declare Function FindFirstFileA Lib "Kernel32" _ (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFileA Lib "Kernel32" _ (ByVal hFindfile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "Kernel32" _ (ByVal hFindfile As Long) As Long
Dim FileFindData As WIN32_FIND_DATA
Private Declare Function CopyFileW Lib _ "Kernel32" (ByVal lpExistingFileName As Long, _ ByVal lpNewFileName As Long, _ ByVal bFailIfExists As Long) As Long '-------------------------------------------- Public Function CopyFile(ByVal Source As String, _ ByVal Dest As String) As Boolean Source = "?" & Source Dest = "?" & Dest CopyFile = (CopyFileW(StrPtr(Source), StrPtr(Dest), False) <> 0) End Function '-------------------------------------------- Sub Test() Dim Source As String, Dest As String Dim Fichier As String, Elt As Variant Dim Nom As String, rep As String
'*********Variables à définir******************
'Répertoire contenant fichiers et sous-répertoires Source = "C:pour la première" rep = "C:pour la première" Dest = "c:Test1"
If Dir(Source, vbDirectory) <> "" Then ReDim Arr(1 To 1) Recurse Source, rep, Dest, Arr(), Fichier If UBound(Arr) > 0 Then For Each Elt In Arr If Not IsEmpty(Elt) Then Nom = Application.Substitute(Elt, Source, "") CopyFile Elt, Dest & Nom End If Next End If Else MsgBox "Chemin inexistant " & Source End If End Sub '-------------------------------------------- Private Sub Recurse(ByVal Chemin As String, rep As String, _ Dest As String, Arr(), Fichier As String)
Dim hFindfile As Long, X As Long, Commande As String, Nom As String hFindfile = FindFirstFileA(Chemin & "*.*", FileFindData) FindNextFileA hFindfile, FileFindData If FindNextFileA(hFindfile, FileFindData) = 0 Then FindClose hFindfile Exit Sub End If Do Fichier = Chemin & Left$(FileFindData.cFileName, _ InStr(1, FileFindData.cFileName, vbNullChar) - 1) If GetAttr(Fichier) And vbDirectory Then Nom = Application.Substitute(Fichier, rep, "") If Dir(Dest & Nom, vbDirectory) = "" Then VBA.MkDir Dest & Nom End If Recurse Fichier & "", rep, Dest, Arr(), Fichier Else Arr(UBound(Arr)) = Fichier ReDim Preserve Arr(1 To UBound(Arr) + 1) End If Loop While FindNextFileA(hFindfile, FileFindData) FindClose hFindfile End Sub '----------------------------------
"michdenis" a écrit dans le message de groupe de discussion : i5lm7d$vst$ L'API de Windows dans l'exemple précédent supporte des chemins allant jusqu'à 260 caractères
Voici une autre approche; Elle copie fichier par fichier. Il faut donc l'insérer dans un boucle sur un répertoire donné La procédure Exemple te montre comment faire ! Seulement ceci serait suffisant : CopyFile Source, Dest
'------------------------------------ 'Déclaration de L'API dans le haut d'un module Standard Private Declare Function CopyFileW Lib _ "kernel32" (ByVal lpExistingFileName As Long, _ ByVal lpNewFileName As Long, _ ByVal bFailIfExists As Long) As Long '------------------------------------ Public Function CopyFile(ByVal Source As String, _ ByVal Dest As String) As Boolean Source = "?" & Source Dest = "?" & Dest CopyFile = (CopyFileW(StrPtr(Source), StrPtr(Dest), False) <> 0) End Function '------------------------------------ Sub Exemple() Dim Source As String Dim Dest As String Source = "C:pour la premièreFichierCSV_Test.csv" Dest = "C:test1FichierCSV_Test.csv" If CopyFile(Source, Dest) = True Then Call MsgBox("Copie réalisée.") End If End Sub '------------------------------------
"HD" a écrit dans le message de groupe de discussion : i5l97t$30h6$ Je viens de me rendre compte d'un pb... Lorsque le répertoire Source ne contient pas de chemin dépassant les 256 caractères, il est bien intégralement copier sur le répertoire Destination... par contre, si le répertoire Source comporte un fichier avec un chemin dépassant les 256 caractères alors le fichier est bien copié mais... il est copié avec son nom court... il n'apparait donc plus avec le nom "normal" qui lui avait été donné...
-- @+ HD
Voici une procédure complète... tu as 3 variables à définir dans la procédure Test.
Procédure copiant tous les fichiers et sous-répertoires et leurs fichiers respectifs
du chemin source spécifié vers le chemin du répertoire destination spécifié.
Variables et API dans le haut du module Standard.
Reste à tester si les noms très longs passent...
Cela devrait accepter des chemins et noms de fichier jusqu'à 32768 caractères.
IMPORTANT : Ceci écrase tout dans le répertoire de destination sans préavis.
Option Explicit
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
Private Declare Function FindFirstFileA Lib "Kernel32" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFileA Lib "Kernel32" _
(ByVal hFindfile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "Kernel32" _
(ByVal hFindfile As Long) As Long
Dim FileFindData As WIN32_FIND_DATA
Private Declare Function CopyFileW Lib _
"Kernel32" (ByVal lpExistingFileName As Long, _
ByVal lpNewFileName As Long, _
ByVal bFailIfExists As Long) As Long
'--------------------------------------------
Public Function CopyFile(ByVal Source As String, _
ByVal Dest As String) As Boolean
Source = "\?" & Source
Dest = "\?" & Dest
CopyFile = (CopyFileW(StrPtr(Source), StrPtr(Dest), False) <> 0)
End Function
'--------------------------------------------
Sub Test()
Dim Source As String, Dest As String
Dim Fichier As String, Elt As Variant
Dim Nom As String, rep As String
'*********Variables à définir******************
'Répertoire contenant fichiers et sous-répertoires
Source = "C:pour la première"
rep = "C:pour la première"
Dest = "c:Test1"
If Dir(Source, vbDirectory) <> "" Then
ReDim Arr(1 To 1)
Recurse Source, rep, Dest, Arr(), Fichier
If UBound(Arr) > 0 Then
For Each Elt In Arr
If Not IsEmpty(Elt) Then
Nom = Application.Substitute(Elt, Source, "")
CopyFile Elt, Dest & Nom
End If
Next
End If
Else
MsgBox "Chemin inexistant " & Source
End If
End Sub
'--------------------------------------------
Private Sub Recurse(ByVal Chemin As String, rep As String, _
Dest As String, Arr(), Fichier As String)
Dim hFindfile As Long, X As Long, Commande As String, Nom As String
hFindfile = FindFirstFileA(Chemin & "*.*", FileFindData)
FindNextFileA hFindfile, FileFindData
If FindNextFileA(hFindfile, FileFindData) = 0 Then
FindClose hFindfile
Exit Sub
End If
Do
Fichier = Chemin & Left$(FileFindData.cFileName, _
InStr(1, FileFindData.cFileName, vbNullChar) - 1)
If GetAttr(Fichier) And vbDirectory Then
Nom = Application.Substitute(Fichier, rep, "")
If Dir(Dest & Nom, vbDirectory) = "" Then
VBA.MkDir Dest & Nom
End If
Recurse Fichier & "", rep, Dest, Arr(), Fichier
Else
Arr(UBound(Arr)) = Fichier
ReDim Preserve Arr(1 To UBound(Arr) + 1)
End If
Loop While FindNextFileA(hFindfile, FileFindData)
FindClose hFindfile
End Sub
'----------------------------------
"michdenis" <michdenis@hotmail.com> a écrit dans le message de groupe de discussion : i5lm7d$vst$1@speranza.aioe.org...
L'API de Windows dans l'exemple précédent supporte des
chemins allant jusqu'à 260 caractères
Voici une autre approche; Elle copie fichier par fichier.
Il faut donc l'insérer dans un boucle sur un répertoire donné
La procédure Exemple te montre comment faire !
Seulement ceci serait suffisant : CopyFile Source, Dest
'------------------------------------
'Déclaration de L'API dans le haut d'un module Standard
Private Declare Function CopyFileW Lib _
"kernel32" (ByVal lpExistingFileName As Long, _
ByVal lpNewFileName As Long, _
ByVal bFailIfExists As Long) As Long
'------------------------------------
Public Function CopyFile(ByVal Source As String, _
ByVal Dest As String) As Boolean
Source = "\?" & Source
Dest = "\?" & Dest
CopyFile = (CopyFileW(StrPtr(Source), StrPtr(Dest), False) <> 0)
End Function
'------------------------------------
Sub Exemple()
Dim Source As String
Dim Dest As String
Source = "C:pour la premièreFichierCSV_Test.csv"
Dest = "C:test1FichierCSV_Test.csv"
If CopyFile(Source, Dest) = True Then
Call MsgBox("Copie réalisée.")
End If
End Sub
'------------------------------------
"HD" <hd@anti.spam.fr> a écrit dans le message de groupe de discussion : i5l97t$30h6$1@saria.nerim.net...
Je viens de me rendre compte d'un pb... Lorsque le répertoire Source ne
contient pas de chemin dépassant les 256 caractères, il est bien
intégralement copier sur le répertoire Destination... par contre, si le
répertoire Source comporte un fichier avec un chemin dépassant les 256
caractères alors le fichier est bien copié mais... il est copié avec son nom
court... il n'apparait donc plus avec le nom "normal" qui lui avait été
donné...
Voici une procédure complète... tu as 3 variables à définir dans la procédure Test.
Procédure copiant tous les fichiers et sous-répertoires et leurs fichiers respectifs du chemin source spécifié vers le chemin du répertoire destination spécifié.
Variables et API dans le haut du module Standard. Reste à tester si les noms très longs passent... Cela devrait accepter des chemins et noms de fichier jusqu'à 32768 caractères.
IMPORTANT : Ceci écrase tout dans le répertoire de destination sans préavis.
Option Explicit Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type
Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * 260 cAlternate As String * 14 End Type
Private Declare Function FindFirstFileA Lib "Kernel32" _ (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFileA Lib "Kernel32" _ (ByVal hFindfile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "Kernel32" _ (ByVal hFindfile As Long) As Long
Dim FileFindData As WIN32_FIND_DATA
Private Declare Function CopyFileW Lib _ "Kernel32" (ByVal lpExistingFileName As Long, _ ByVal lpNewFileName As Long, _ ByVal bFailIfExists As Long) As Long '-------------------------------------------- Public Function CopyFile(ByVal Source As String, _ ByVal Dest As String) As Boolean Source = "?" & Source Dest = "?" & Dest CopyFile = (CopyFileW(StrPtr(Source), StrPtr(Dest), False) <> 0) End Function '-------------------------------------------- Sub Test() Dim Source As String, Dest As String Dim Fichier As String, Elt As Variant Dim Nom As String, rep As String
'*********Variables à définir******************
'Répertoire contenant fichiers et sous-répertoires Source = "C:pour la première" rep = "C:pour la première" Dest = "c:Test1"
If Dir(Source, vbDirectory) <> "" Then ReDim Arr(1 To 1) Recurse Source, rep, Dest, Arr(), Fichier If UBound(Arr) > 0 Then For Each Elt In Arr If Not IsEmpty(Elt) Then Nom = Application.Substitute(Elt, Source, "") CopyFile Elt, Dest & Nom End If Next End If Else MsgBox "Chemin inexistant " & Source End If End Sub '-------------------------------------------- Private Sub Recurse(ByVal Chemin As String, rep As String, _ Dest As String, Arr(), Fichier As String)
Dim hFindfile As Long, X As Long, Commande As String, Nom As String hFindfile = FindFirstFileA(Chemin & "*.*", FileFindData) FindNextFileA hFindfile, FileFindData If FindNextFileA(hFindfile, FileFindData) = 0 Then FindClose hFindfile Exit Sub End If Do Fichier = Chemin & Left$(FileFindData.cFileName, _ InStr(1, FileFindData.cFileName, vbNullChar) - 1) If GetAttr(Fichier) And vbDirectory Then Nom = Application.Substitute(Fichier, rep, "") If Dir(Dest & Nom, vbDirectory) = "" Then VBA.MkDir Dest & Nom End If Recurse Fichier & "", rep, Dest, Arr(), Fichier Else Arr(UBound(Arr)) = Fichier ReDim Preserve Arr(1 To UBound(Arr) + 1) End If Loop While FindNextFileA(hFindfile, FileFindData) FindClose hFindfile End Sub '----------------------------------
"michdenis" a écrit dans le message de groupe de discussion : i5lm7d$vst$ L'API de Windows dans l'exemple précédent supporte des chemins allant jusqu'à 260 caractères
Voici une autre approche; Elle copie fichier par fichier. Il faut donc l'insérer dans un boucle sur un répertoire donné La procédure Exemple te montre comment faire ! Seulement ceci serait suffisant : CopyFile Source, Dest
'------------------------------------ 'Déclaration de L'API dans le haut d'un module Standard Private Declare Function CopyFileW Lib _ "kernel32" (ByVal lpExistingFileName As Long, _ ByVal lpNewFileName As Long, _ ByVal bFailIfExists As Long) As Long '------------------------------------ Public Function CopyFile(ByVal Source As String, _ ByVal Dest As String) As Boolean Source = "?" & Source Dest = "?" & Dest CopyFile = (CopyFileW(StrPtr(Source), StrPtr(Dest), False) <> 0) End Function '------------------------------------ Sub Exemple() Dim Source As String Dim Dest As String Source = "C:pour la premièreFichierCSV_Test.csv" Dest = "C:test1FichierCSV_Test.csv" If CopyFile(Source, Dest) = True Then Call MsgBox("Copie réalisée.") End If End Sub '------------------------------------
"HD" a écrit dans le message de groupe de discussion : i5l97t$30h6$ Je viens de me rendre compte d'un pb... Lorsque le répertoire Source ne contient pas de chemin dépassant les 256 caractères, il est bien intégralement copier sur le répertoire Destination... par contre, si le répertoire Source comporte un fichier avec un chemin dépassant les 256 caractères alors le fichier est bien copié mais... il est copié avec son nom court... il n'apparait donc plus avec le nom "normal" qui lui avait été donné...