Macro importation de donné ne fonctionnant pas en réseau

**Pascal loria** · 05/12/2018, 12h56

Bonjour a tous ,

Je crée ce poste car j'ai un petit soucis avec une macro a mon travail. Je fais du traitement de donné dans le cadre de résultat d'essai de laboratoire.

J'ai fais une macro me permettant d'extraire les donné de fichier .CSV qui fonctionne très bien lorsque mes fichier sont sur mon poste.
Par contre des que mes fichier et le classeur excel sont sur le réseau cela ne fonctionne plus.

Je vais chercher l'emplacement des donnés a extraire a partir du chemin de mon classeur excel et les deux se trouvent dans un même répertoire.

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Sub extraction_NBS_EU()
'
' Macro1 Macro
''derniere ligne
Dim lnglinge As Long
Dim classeur1 As String
Dim RepParent As String, RepInitial As String, RepII As String
Dim Name() As String
 
'Recherche de l'adresse des dossier parents
ChDir (ThisWorkbook.Path)
RepInitial = CurDir(ThisWorkbook.Path)
ChDir ".."
RepParent = CurDir(ThisWorkbook.Path)
ChDir ".."
RepII = CurDir(ThisWorkbook.Path)
 
 
 
 
classeur1 = Dir(RepII & "\05 - Mesures\NBS IRTF\")
Range("a4").Select
Do While classeur1 <> "" And classeur1 <> ThisWorkbook.Name
 
'ouverture du classeur cible
Workbooks.Open Filename:=RepII & "\05 - Mesures\NBS IRTF\" & classeur1, Local:=True
 
'derniere ligne de valeur
lnglinge = Range("a10000").End(xlUp).Row
 
    If Range("b1") = "" Then
        Columns("A:A").Select
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        Range("c3").Select
 
         Cells.Replace What:=".", Replacement:=".", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
     End If
 
    Range("A2:C" & lnglinge).Select
    Selection.Copy
    ThisWorkbook.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'fermer le classeur xx
Name = Split(classeur1, ".")
 
Windows(classeur1).Activate
ActiveWorkbook.SaveAs Filename:= _
        RepII & "\05 - Mesures\NBS IRTF\" & Name(0) & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 
ActiveWindow.Close
 
'*************Deplacer fichier********************
Dim SourceFile, DestinationFile
'identifier le fichier source (adresse complete)
SourceFile = RepII & "\05 - Mesures\NBS IRTF\" & classeur1
'identifier le fichier de destination (adresse complete)
DestinationFile = RepII & "\05 - Mesures\NBS IRTF\Archive\" & classeur1
'MsgBox DestinationFile 'message box pour verifier le nom
'MsgBox SourceFile          'message box pour verifier le nom
FileCopy SourceFile, DestinationFile
Kill SourceFile
'**************Deplacer fichier*****************************
 
 
classeur1 = Dir()
ActiveCell.Offset(0, 3).Select
 
 
Loop
 
 
End Sub

CI dessus le code de la macro en question. avez vous des idées de modification a faire pour que cette macro fonction aussi lorsque le dossier est sur un réseau ?
Je precise que j'ai bien les droits d'ecriture et de modification/supression sur ce réseau.

Merci d'avance

Si vous avez d'autre question n’hésitez pas .

**Menhir** · 05/12/2018, 13h39

Envoyé par Pascal loria

mes fichier et le classeur excel sont sur le réseau

Quel type de réseau ?

cela ne fonctionne plus.

C'est un peu vague comme description de dysfonctionnement.
Est-ce que le code bugue ? Dans ce cas, quel est le message d'erreur et quelle ligne de code est désignée par le débugage ?
Est-ce que le résultat est anormal ? Dans ce cas, quelle est la différence entre le résultat attendu et celui obtenu ?

**Pierre Fauconnier** · 05/12/2018, 17h47

Salut.

Il me semble que tu as bien compliqué la définition du chemin réseau de ton fichier. Je peux supposer, au vu des chdir en cascade, que ton problème pourrait venir de là.

Il y aurait à dire sur l'architecture de ton code, mais avant ça, il serait intéressant de préciser sur quelle ligne ça bloque. Lorsque la ligne est en jaune, tu passes la souris sur les variables pour voir dans l'infobulle ce qu'elles affichent comme valeurs. Tu peux aussi, via la barre de menu "Affichage" du VBA, afficher la fenêtre des variables locales qui te renseignera sur les valeurs utilisées par ton code. En général, ça permet de comprendre d'où vient le problème. Tu peux aussi démarrer le code avec F8 pour avancer en pas à pas et observer le comportement des variables durant l'exécution.

**Pascal loria** · 06/12/2018, 08h03

Bonjour , tout d'abord merci pour vos réponses rapides.

En effet je n'ai pas pensé à vous indiquer les messages d'erreurs. Je vous prie de m'en excuser.

Erreur d’exécution '5';
Argument ou appel de procédure incorrect

et la ligne en jaune :

Code :

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

RepInitial = CurDir(ThisWorkbook.Path)

Quand je passe mon curseur dessus RepInitial ="" et ThisWorkbook.Path renvoie bien a l'adresse du workbook.

Effectivement mon code doit plutôt ressembler a du bricolage pour vous , j'ai appris en autodidacte beaucoup grâce à ce forum. Et j'ai complété cela par une formation de 3 jours sur les bases du VBA .

Je suis ouvert à toute proposition d’amélioration

Et vous remercie pour votre aide et votre temps.

Pour le réseau c'est un réseau d'entreprise type NAS (je crois) je n'ai vraiment plus d'information. L'adresse commence par \\ ( peut-être que ma variable n'aime pas le double antislash ?)

**Menhir** · 06/12/2018, 08h37

Envoyé par Pascal loria

Erreur d'execution '5'; Argument ou appel de procédure incorrect

Code :

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

RepInitial = CurDir(ThisWorkbook.Path)

L'argument de CurDir ne peut être qu'un nom de lecteur, pas un chemin.
https://docs.microsoft.com/fr-fr/off...urdir-function

CurDir est fait pour indiquer le répertoire courant, pas pour le modifier.

Tu vois, c'est bien plus facile quand on a les bonnes infos dans la demande.

**Pascal loria** · 06/12/2018, 09h59

Merci pour cette information .

Quelle syntaxe devrais je utiliser ?

Le chemin de mon classeur est : \\magnas-bsl3-1\LEM_PPC\PPC_FER_FEU\01_En_Cours\18.xxx\06 - Résultats\Cahier_Essai

Chemin des fichier a extraire : \\magnas-bsl3-1\LEM_PPC\PPC_FER_FEU\01_En_Cours\18.xxx\05 - Mesures\NBS IRTF

Je comptais partir de l’emplacement de mon classeur car le 18.xxx change les x sont remplacé par des chiffres.
Donc je souhaite remonter de 2 dossier parents et ajouter l'adresse "\05 - Mesures\NBS IRTF\"

Comment feriez vous ceci ?

merci d'avance.

**Menhir** · 06/12/2018, 10h19

Envoyé par Pascal loria

Quelle syntaxe devrais je utiliser ?

L'aide VBA est claire : CurDir ne fonctionne qu'avec une lettre de lecteur. Donc, si le disque ne peut pas être désigné par une lettre, CurDir n'est pas utilisable.

Par contre, si ton but est de récupérer le chemin où se trouve le classeur de la macro, il suffit d'écrire :

Code :

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

RepInitial = ThisWorkbook.Path

Si tu veux atteindre d'autres répertoires en partant de cette base, tu peux utiliser des fonctions comme Split (avec "\" comme séparateur) qui tronçonnera ce résultat en série de répertoires.
https://docs.microsoft.com/fr-fr/off...split-function

Ou bien tu supprimes les deux derniers répertoires de la chaine en utilisant deux fois une combinaison de InStrRev() et Mid().

**Patrice740** · 06/12/2018, 10h27

Bonjour,

Comme dit Menhir :

Code :

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

1
2
3
4
5
6
7
8
Sub xxx()
Dim s As String
  s = ThisWorkbook.Path
  ' pour remonter de 2 répertoires :
  s = Left(s, InStrRev(s, "\") - 1)
  s = Left(s, InStrRev(s, "\") - 1)
  MsgBox s
End Sub

**Pascal loria** · 06/12/2018, 10h33

Merci pour cette réponse. Cela m'a beaucoup aider

Voici le nouveau code qui fonctionne, si jamais ça aide des gens qui passe.

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Option Explicit
 
Sub extraction_NBS_Concept()
'
' Macro1 Macro
''derniere ligne
Dim lnglinge As Long
Dim classeur1 As String
Dim RepII As String
Dim Name() As String
 
'Recherche de l'adresse des dossier parents
 
Dim s As String
  s = ThisWorkbook.Path
  ' pour remonter de 2 répertoires :
  s = Left(s, InStrRev(s, "\") - 1)
  s = Left(s, InStrRev(s, "\") - 1)
 
RepII = s
 
classeur1 = Dir(RepII & "\05 - Mesures\NBS FR concept\")
Range("a4").Select
Do While classeur1 <> "" And classeur1 <> ThisWorkbook.Name
 
'ouverture du classeur cible
Workbooks.Open Filename:=RepII & "\05 - Mesures\NBS FR concept\" & classeur1, Local:=True
 
'derniere ligne de valeur
lnglinge = Range("a10000").End(xlUp).Offset(-4, 0).Row
 
    If Range("b1") = "" Then
        Columns("A:A").Select
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        Range("c3").Select
 
         Cells.Replace What:=".", Replacement:=".", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
     End If
 
    Range("A20:C" & lnglinge).Select
    Selection.Copy
    ThisWorkbook.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'fermer le classeur xx
Name = Split(classeur1, ".")
 
Windows(classeur1).Activate
ActiveWorkbook.SaveAs Filename:= _
        RepII & "\05 - Mesures\NBS FR concept\" & Name(0) & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 
ActiveWindow.Close
 
'*************Deplacer fichier********************
Dim SourceFile, DestinationFile
'identifier le fichier source (adresse complete)
SourceFile = RepII & "\05 - Mesures\NBS FR concept\" & classeur1
'identifier le fichier de destination (adresse complete)
DestinationFile = RepII & "\05 - Mesures\NBS FR concept\Archive\" & classeur1
'MsgBox DestinationFile 'message box pour verifier le nom
'MsgBox SourceFile          'message box pour verifier le nom
FileCopy SourceFile, DestinationFile
Kill SourceFile
'**************Deplacer fichier*****************************
 
 
classeur1 = Dir()
ActiveCell.Offset(0, 3).Select
 
 
Loop
 
 
End Sub

C'est un peu brouillon mais ça marche, si vous avez une méthode plus "propre" n’hésiter pas je suis toujours a la recherche de nouvelles connaissances en VBA

Encore merci pour votre aide et vos réponse rapide.

Edit : après avoir vu le message de Patrice740.

Ton morceau de code est bien plus efficace

merci ! il fonctionne parfaitement avec ma macro .

**Patrice740** · 06/12/2018, 10h52

Envoyé par Pascal loria

Edit : après avoir vu le message de Patrice740.
Ton morceau de code est bien plus efficace

merci ! il fonctionne parfaitement avec ma macro .

Il est surtout didactique mais il y a bien plus simple au lieu de :

Code :

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

1
2
3
4
5
6
7
'Dim s As String
  s = ThisWorkbook.Path
  ' pour remonter de 2 répertoires :
  s = Left(s, InStrRev(s, "\") - 1)
  s = Left(s, InStrRev(s, "\") - 1)
 
RepII = s

Écrire tout simplement :

Code :

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

RepII = ThisWorkbook.Path & "\..\..\"

**Menhir** · 06/12/2018, 11h47

Envoyé par Pascal loria

si vous avez une méthode plus "propre" n’hésiter pas

Juste un petit détail : supprimer la variable "s" et mettre "RepII" à la place. Utiliser un intermédiaire n'a pas d'intérêt ici.

**Pascal loria** · 06/12/2018, 13h06

Votre dernier code ne semble pas fonctionner avec la suite de ma macro qui consiste a rajouter derrière un

Code :

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

classeur1 = Dir(RepII & "\05 - Mesures\NBS FR concept\")

j'obtiens classeur1= ""

Je vais rester sur la première version qui fonctionne a merveille.

Merci pour vos conseil j'ai mis le sujet en résolut. Vous avez été très clair et efficace. grâce a vous et se super forum je m'y connais un peu mieux en VBA

Encore merci.

**Patrice740** · 06/12/2018, 13h20

Désolé, il y a un "\" en trop !

Soit :

Code :

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

1
2
RepII = ThisWorkbook.Path & "\..\..\"
classeur1 = Dir(RepII & "05 - Mesures\NBS FR concept\")

Soit :

Code :

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

1
2
RepII = ThisWorkbook.Path & "\..\.."
classeur1 = Dir(RepII & "\05 - Mesures\NBS FR concept\")

Macro importation de donné ne fonctionnant pas en réseau

Macros et VBA Excel

Discussions similaires

Partager

Partager