Discussion :

[zooffy]

Bonjour

Je viens vers vous car en interne, pour l'instant, personne ne voit l'origine du problème.

Je fais une application qui déplace des fichiers entre différents répertoires.
Le code de base est simple :

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
 
Dim oFSO As New Scripting.FileSystemObject
Dim oFLdDepart, oFLdArrivee As Folder
 
Set oFldDepart = oFSO.GetFolder("\\mon.server\groupshares\REPAPPLI\RepDepart")
Set oFLdArrivee = oFSO.GetFolder("\\mon.server\groupshares\REPAPPLI\RepArrivee")
 
For Each oFl In oFLdDepart.Files
'J'ouvre un TS pour lire des choses dans le fichier
Dim ts As TextStream
Set ts = oFl.OpenAsTextStream(ForReading, TristateUseDefault)
 
ts.Close
oFl.Move oFLdArrivee & "\"
GoTo Suivant
 
Next

J'ai présenté le code simplifié parce que, vous vous doutez bien que j'ai beaucoup de répertoire mais l'idée est là. J'ai un repertoire dans lequel il y a plein de fichiers et selon les données que je lis dans chaque fichier, je range dans un répertoire prévu. Hier matin, j'ai lancé l'appli et ça marchait bien. Hier après midi j'ai lancé l'appli et ça a marché pour certains fichiers mais à un moment il a bloqué et avec des messages d'erreur bizarre, je dirai pas très cohérents

Et maintenant il bloque sur le premier fichier avec :
- file already exists : après verification, non, le fichier n'existe pas dans le repertoire de destination. Si j'insiste il me remet toujours le même message
- permission denied : ce message survient lorsque je suis allé voir dans le répetoire avec un Poste de Travail si le fichier existe ou pas

Et si je déplace le fichier à la main je n'ai pas de souci, donc j'ai les droits et je passe à la ligne suivante pour faire avancer le code et il bloque sur le fichier suivant et ainsi de suite. J'ai testé sur une dizaine de fichiers.

J'ai plus de cheveu sur ma tête, vous avez une idée (ou des cheveux de rechange) ?

Merci et bonne journée.

[marot_r]

Bonjour.

Je pense que le problème peut venir de là :

Code :

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

1
2
3
Set ts = oFl.OpenAsTextStream(ForReading, TristateUseDefault)
 
ts.Close

À mon avis le close n'a pas vraiment libéré le fichier. Il y a des caches à différents niveaux (mémoire vive, processeur, carte d'interface avec le disque dur, ...) et ils ne sont peut-être pas tous vidés quand tu tentes de déplacer le fichier.
Essaye en ajoutant set st=nothing:doevents après le ts.close.
Si cela ne donne rien, essaye en ajoutant une pause (genre 1 seconde) avec l'API Sleep après pour donner le temps à Windows de finir ses écritures.

Pour l'existence du fichier alors qu'il n'est pas là, je n'ai pas d'explication.

A+

[zooffy]

Merci pour ton aide.

Je vais essayer ta solution, mais je doute que cela vienne de là car en poussant mes tests, je me suis aperçu que certains mouvements posaient problème et pas d'autres.
Visiblement cela dépend du repertoire de destination et surtout de sa date de création.

Dans les répertoires que j'ai créé hier, ça passe pas et ceux que j'ai créé en Septembre ça passe.
Il se trouve que j'ai eu une "reconstruction" de profil windows le week-end de passage de Septembre à Octobre.

Je continue les tests et j'essaye ta solution.

[marot_r]

OK, oui, en effet cela peut aussi venir des droits de l'utilisateur.

Je n'y avais pas pensé.

A+

[zooffy]

Bon, j'ai le droit à un gage, désolé pour le derangement.

J'ai fait mon gros boulet, voici l'explication

Code :

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

1
2
3
4
 
oFl.Move oFLdArrivee & "\"
 
oFl.Move oFLdArrivee

J'ai oublié le & "\" sur certains répertoire et du coup, ça génère l'erreur du fichier qui existe et du "permission denied"

Bref, j'attend le gage..............




Bonne journée à tous

[marot_r]

Bonjour.

Étant tanné des manipulations de répertoire et de nom de fichier, je me suis fait un module de classe dédié à cela.
Je l'ai appellé clsInfoFichier.
Elle fait un peu plus que simplement contenir les informations et elle m'est très utile.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Compare Database
Option Explicit
 
'Version 2017-10-10 08h58
 
Public infoFichierTemp As clsInfoFichier 'Une copie du fichier sur le disque local
 
Public numero As Long
Public Nom As String
 
Dim mExtention As String
 
Dim mRepertoire As String

Code :

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

1
2
3
4
5
6
7
8
9
Public Property Let Repertoire(prmRepertoire As String)
 
    If Right(prmRepertoire, 1) = "\" Then
            mRepertoire = Left(prmRepertoire, Len(prmRepertoire) - 1)
        Else
            mRepertoire = prmRepertoire
    End If
 
End Property

Code :

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

1
2
3
Public Property Get Repertoire() As String
    Repertoire = mRepertoire
End Property

Code :

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

1
2
3
4
5
6
7
8
9
Public Property Let Extention(prmExtention As String)
 
    If Left(prmExtention, 1) = "." Then
            mExtention = Mid(prmExtention, 2)
        Else
            mExtention = prmExtention
    End If
 
End Property

Code :

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

1
2
3
Public Property Get Extention() As String
    Extention = mExtention
End Property

Code :

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

1
2
3
4
5
6
7
8
Private Sub Class_Terminate()
 
    If Not Me.infoFichierTemp Is Nothing Then
        Call Me.infoFichierTemp.SupprimeFichier
        Set Me.infoFichierTemp = Nothing
    End If
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Property Let Repertoire_Nom_Extention(prmRepertoire_Nom_Extention As String)
    'Découpe un nom avec l'extention en ses morceaux
    Dim positionSlash As Long: positionSlash = InStrRev(prmRepertoire_Nom_Extention, "\")
 
    If positionSlash <> 0 Then
            Me.Repertoire = Left(prmRepertoire_Nom_Extention, positionSlash - 1)
            Me.Nom_Extention = Mid(prmRepertoire_Nom_Extention, positionSlash + 1)
        Else
            'Il n'y a de Repertoire
            Me.Repertoire = ""
            Me.Nom_Extention = prmRepertoire_Nom_Extention
    End If
 
End Property

Code :

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

1
2
3
Public Property Get Repertoire_Nom_Extention() As String
    Repertoire_Nom_Extention = Me.Repertoire & "\" & Me.Nom & "." & Me.Extention
End Property

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Property Let Nom_Extention(prmNom_Extention As String)
    'Découpe un nom avec l'extention en ses morceaux
    Dim positionPoint As Long: positionPoint = InStrRev(prmNom_Extention, ".")
 
    If positionPoint <> 0 Then
            Me.Nom = Left(prmNom_Extention, positionPoint - 1)
            Me.Extention = Mid(prmNom_Extention, positionPoint + 1)
        Else
            'Il n'y a pas d'extention
            Me.Nom = prmNom_Extention
            Me.Extention = ""
    End If
 
End Property

Code :

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

1
2
3
Public Property Get Nom_Extention() As String
    Nom_Extention = Me.Nom & IIf(Me.Extention <> "", ".", "") & Me.Extention
End Property

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
Public Function CreerFichierTemp() As clsInfoFichier
    'Recopie le fichier dans MyDocuments
    ' Retourne le nouveau Repertoire
    Set Me.infoFichierTemp = New clsInfoFichier
 
    '=== Lit "MyDocuments"
    ' quelle que soit la langue
    Dim wshShell As Object: Set wshShell = CreateObject("WScript.Shell")
    Me.infoFichierTemp.Repertoire = wshShell.SpecialFolders("MyDocuments")
    Set wshShell = Nothing
    '--- Lit "MyDocuments"
 
    Me.infoFichierTemp.Nom_Extention = Me.Nom_Extention
 
    Call Me.infoFichierTemp.SupprimeFichier
 
    Call apiFileCopy(Me.Repertoire_Nom_Extention, Me.infoFichierTemp.Repertoire_Nom_Extention)
 
End Function

Code :

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

1
2
3
4
5
6
7
Public Sub SupprimeFichier()
    'Supprime le fichier
    If Dir(Me.Repertoire_Nom_Extention) <> "" Then
        Kill Me.Repertoire_Nom_Extention
    End If
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Public Sub AssurerConformiteNom()
    'Remplace les caractères non autorisés du nom par des soulignés (_).
    Dim listeCaractere As String: listeCaractere = "\/:*?""<>|"
    Dim c As String
 
    Dim i As Long: For i = 1 To Len(listeCaractere)
        c = Mid(listeCaractere, i, 1)
        Me.Nom = Replace(Me.Nom, c, "_")
    Next i
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function VerifierExistenceFichier(Optional prmTitre As String = "") As clsResultVerif
    'Vérifie si le fichier existe.
    ' Retourne un message d'erreur dans le cas contraîre.
    Dim result As New clsResultVerif
 
    If Dir(Me.Repertoire_Nom_Extention) = "" Or Me.Nom_Extention = "" Then
        Call result.AjouterErreur(prmTitre & IIf(prmTitre <> "", " - ", "") & "Il n'y a pas de fichier [" & Me.Nom_Extention & "]")
        Call result.AjouterErreur(" dans le répertoire [" & Me.Repertoire & "].")
    End If
 
    Set VerifierExistenceFichier = result
    Set result = Nothing
End Function

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
Public Function VerifierUtilisationFichier(Optional prmTitre As String = "") As clsResultVerif
    'Vérifie si le fichier est actuellement utilisé
    ' Retourne un message d'erreur dans le cas contraîre.
 
    On Error GoTo Err_VerifierUtilisationFichier
 
    Dim result As New clsResultVerif
 
    Dim numFic As Long: numFic = FreeFile()
    Open Me.Repertoire_Nom_Extention For Append Access Write Lock Read As #numFic 'Essaye d'ouvrir le fichier en usage exclusif
    Close #numFic
 
Exit_VerifierUtilisationFichier:
    Set VerifierUtilisationFichier = result
    Set result = Nothing
    Exit Function
 
Err_VerifierUtilisationFichier:
    Select Case Err.Number
        Case 70 'fichier utilisé
            Call result.AjouterErreur(prmTitre & IIf(prmTitre <> "", " - ", "") & "Le fichier [" & Me.Nom_Extention & "]")
            Call result.AjouterErreur(" dans le répertoire [" & Me.Repertoire & "] est en cours d'utilisation.")
        Case Else
            Call mdlErreur.AfficherErreurStandard(Err)
    End Select
 
    Resume Exit_VerifierUtilisationFichier
 
End Function

Code :

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

1
2
3
Public Function ToString() As String
    ToString = Me.Repertoire_Nom_Extention
End Function

exemple d'utilisation pour décomposer un chemin complet en informations de base.

Code :

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

1
2
3
4
5
6
7
8
dim infoFichier as new clsInfoFichier
infoFichier.Reperetoire_Nom_Extension="X:\UnChemin\Fichier.Ext"
 
debug.print infoFichier.Repertoire
debug.print infoFichier.Nom
debug.print infoFichier.Extention
 
set  infoFichier=nothing

A+

[zooffy]

Merci beaucoup pour ton code.

C'est du très beau travail.

Bonne journée à toi.