Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

[VBA] Erreur avec un FSO.CopyFolder limitation dans les longueurs de chemins ?

24 réponses
Avatar
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.

Merci d'avance pour votre aide
--
@+
HD

4 réponses

1 2 3
Avatar
HD
Un lecteur virtuel créer via la commande SUBST pourrait donc être la
solution ?

Mais cette commande est elle compatible avec Windows 7 ?

--
@+
HD
Avatar
michdenis
| Mais cette commande est elle compatible avec Windows 7 ?

De Windows 98 à Windows7 inclusivement... je crois !

--
MichD
--------------------------------------------


"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
Avatar
michdenis
| Un lecteur virtuel créer via la commande SUBST pourrait donc être la solution ?

Si tu trouves une solution avec les éléments énoncés, j'espère que tu la publieras.

--
MichD
--------------------------------------------


"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
Avatar
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
'----------------------------------

--
MichD
--------------------------------------------


"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
'------------------------------------

--
MichD
--------------------------------------------


"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
1 2 3