Problème avec (fso.FileExists(filespec)) + *

**Loupire** · 26/04/2010, 16h29

Bonjour,

Je vous soumet mon problème je dois avant d'éxécuter mon script vérifier si un fichier de type "*.doc" (* car le fichier peut avoir differents noms) existe dans un répertoire précis. Si un fichier exister j'éxécute le script sinon je ferme l'application.

J'utilise :

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
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists("D:\Euromaster\Source\*.doc")) Then
 
EXECUTION DU SCRIPT
 
Else
   MsgBox ("Votre fichier source n'a pas été copier dans le répertoire Source")
   Application.Quit
   Exit Sub
End If
 
GESTION DES ERREURS
 
End Sub

Mais apparement on ne peut utiliser le caractère "*".

Si je mets un nom de fichier fixe il n'y a aucun problème mais ce n'est pas le but !

Je tourne en rond en cherchant sur divers forums et je me tourne donc vers vous.

Merci d'avance ,

**sabzzz** · 26/04/2010, 16h43

bonjour Loupire,

il faudrait boucler sur la collection Files et utiliser l'opérateur Like,

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Test()
Dim fso As Object, Dossier As Object, NomDossier
Dim Files As Object, File As Object, i As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")
    Répertoire = "c:\Temps"         '<-----------------------à adapter
    Set Dossier = fso.GetFolder(Répertoire)
    Set Files = Dossier.Files
    If Files.Count <> 0 Then
        For Each File In Dossier.Files
         If File.Name Like "fi?hi?r.xls" Then
         MsgBox "Fichier existe"
        Next
    End If
End Sub

**Loupire** · 26/04/2010, 17h09

Merci pour cette réponse rapide !

Débutant en VB je suis relativement perdu pour interpretter ce code, et au passage je tiens à préciser qu'il ne peut y avoir qu'un seul "*.doc" dans le dossier (car à la fin de mon script, ce dossier est purgé).

Le code complet sera sans doute plus parlant (le l'ai commenté) :

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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
''''''''''''''''''''''''''''''''''''FICHIER D'EXECUTION TEST 3.0''''''''''''''''''''''''''''''''
Sub Import_Euromaster_6()
Dim ligne As String
Dim NbLigne As Long
Dim i As Long
Dim r As Long
Dim StartTab1 As Long
Dim EndTab1 As Long
Dim mon_tableau() As String
Dim MaRef As Variant
 
'TEST 1
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists("D:\Euromaster\Source\toto.doc")) Then
 
'TEST 2
'Set fso = CreateObject("Scripting.FileSystemObject")
'Set Folder = fso.GetFolder("D:\Euromaster\Source")
'If Folder.Files.Count < 0 Then
'  MsgBox ("Votre fichier source n'a pas été copier dans le répertoire Source")
'End If
 
'TEST 3
'Set fichier = objetFSO.FileExists("D:\Euromaster\Source\*.doc")
'If fichier = False Then
'MsgBox ("Votre fichier source n'a pas été copier dans le répertoire Source")
'Application.Quit
'End If
 
'TEST 4
'ChDir ("D:\Euromaster\Source\")
'f = Dir("*.doc")
'If f = "" Then
'MsgBox ("Votre fichier source n'a pas été copier dans le répertoire Source")
'Exit Sub
'End If
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:="D:\Euromaster\Source\*.doc", Origin:=437, _
    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
    , Space:=False, Other:=False, FieldInfo:=Array(1, 2), _
    TrailingMinusNumbers:=True
 
    Application.DisplayAlerts = False
    jourbis = Day(Now) & "_" & Month(Now) & "_" & Year(Now) '---> Declaration d'une variable jourbis
    SourceFichier = "D:\Euromaster\Source\*.doc" ' Définit le nom et le chemin du fichier source
    DestinationFichier = "D:\Euromaster\Backup\" & "Euromaster_" & jourbis & ".doc" ' Définit le nom du fichier et le nouveau chemin cible
    ActiveWorkbook.SaveAs Filename:=DestinationFichier  ' Copie le fichier source dans le fichier cible.
    MsgBox ("Fichier backup Euromaster créé dans D:\Euromaster\Backup\")
 
    ActiveWorkbook.SaveAs Filename:="D:\Euromaster\Source\import.txt", FileFormat:= _
    xlText, CreateBackup:=False
    SetAttr ("D:\Euromaster\Source\import.txt"), vbHidden
    ActiveWorkbook.Save
    ActiveWindow.Close
    Range("A1").Select
 
On Error GoTo Err
 
Open ("D:\Euromaster\Source\import.txt") For Input As #1
 
    Do While Not EOF(1) '---> premiere boucle qui compte toutes les lignes du document
        Input #1, ligne
        NbLigne = NbLigne + 1
    Loop
 
Close #1
 
Open ("D:\Euromaster\Source\import.txt") For Input As #2 '---> ouverture du fichier en lecture
 
i = 1 '---> declaration des variables
StartTab = 1
EndTab = 0
 
ReDim mon_tableau(NbLigne, 10) '---> initialisation d'un tableau de X lignes et 9 colonnes
 
    Do While Not EOF(2) '---> debut de la seconde boucle
        Input #2, ligne
 
        If Left(ligne, 7) <> "" Then '---> les 7 premiers caracteres de la ligne sont differents de vide
            MaRef = Left(ligne, 7)
 
            If IsNumeric(MaRef) Then '---> les 7 premiers caracteres sont numeriques
 
                If Len(ligne) > 70 Then '---> la ligne des 7 premiers caracteres comporte plus de 50 caracteres
 
                mon_tableau(i, 1) = Mid$(ligne, 1, 7) & "0000" '---> je recupere les informations dans un tableau
                mon_tableau(i, 2) = Mid$(ligne, 20, 7)
                mon_tableau(i, 3) = Mid$(ligne, 76, 1)
                mon_tableau(i, 6) = "zta"
                mon_tableau(i, 7) = "43"
                mon_tableau(i, 8) = "RE"
                mon_tableau(i, 9) = "0"
                i = i + 1
                EndTab = EndTab + 1
 
                End If
 
            End If
 
        End If
 
        If Left(ligne, 18) = "NUMERO DE COMMANDE" Then '---> test sur numerro de commande
 
            For r = StartTab To EndTab
                mon_tableau(r, 4) = Mid$(ligne, 34, 3) '---> 3 premiers caractères du Purch. Order = Code Dealer
 
                Sheets("SAP").Select '---> correspondance entre Code Dealer (.xls) et Sold To Party (SAP)
                Columns("A:A").Select
 
                With Selection.Find(Mid$(ligne, 34, 3)).Activate
                    On Error GoTo Err
                End With
 
                mon_tableau(r, 4) = ActiveCell.Value
                mon_tableau(r + 1, 10) = ActiveCell.Offset(0, 1).Value
 
                Sheets("RDCNORD").Select
 
            Next r
 
            For r = StartTab To EndTab
                mon_tableau(r, 5) = Mid$(ligne, 34, 3) & Mid$(ligne, 37, 4) '---> Purch. Order complet
            Next r
 
            StartTab = EndTab + 1
 
        End If
 
    Loop
 
Close #2
 
For r = 1 To EndTab
    Cells(r + 1, 1).Value = mon_tableau(r, 6) '---> Sales doc. type
    Cells(r + 1, 2).Value = mon_tableau(r, 7) '---> Sales org.
    Cells(r + 1, 3).Value = mon_tableau(r, 8) '---> Distr. Channel
    Cells(r + 1, 4).Value = mon_tableau(r, 9) '---> Division
    Cells(r + 1, 5).Value = mon_tableau(r + 1, 10) '---> Conversion Code Dealer / Sold to Party
    Cells(r + 1, 6).Value = mon_tableau(r, 1) '---> Material
    Cells(r + 1, 7).Value = mon_tableau(r, 2) '---> Customer Material
    Cells(r + 1, 8).Value = mon_tableau(r, 3) '---> Quantity
    Cells(r + 1, 10).Value = mon_tableau(r, 5) '---> Purch. Order complet
Next r
 
Application.DisplayAlerts = False
Range("A1").Select
Sheets("RDCNORD").Select '---> Selection de la page RDCNORD
Selection.CurrentRegion.Select '---> Selection de la plage
Selection.Copy
Workbooks.Add
ActiveSheet.Paste '---> Copie de la plage dans un nouveau classeur et nouvelle page
ActiveSheet.Rows.AutoFit '---> Ajustement automatique des lignes et colonnes du tableau
ActiveSheet.Columns.AutoFit
Sheets("Feuil2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Feuil3").Select
ActiveWindow.SelectedSheets.Delete
 
jour = Day(Now) & "_" & Month(Now) & "_" & Year(Now) '---> Declaration d'une variable jour
 
monfichier = "D:\Euromaster\Incoming\" & "Euromaster_" & jour '---> Creation du classeur a endroit precis
ActiveSheet.Name = "Euromaster_" & jour
 
    If Dir(monfichier & ".xls") <> "" Then '---> Verification si classeur existe deja
        MsgBox ("Un fichier d'IMPORT existe déjà, veuillez le supprimer/déplacer avant nouvelle copie")
 
    Else
 
        monfichier = monfichier & ".xls" '---> Classeur inexistant = creation classeur
        ActiveWorkbook.SaveAs Filename:= _
        monfichier, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWorkbook.Close SaveChanges:=True '---> Fermeture automatique du nouveau classeur
        MsgBox ("Fichier d'import Euromaster créé dans D:\Euromaster\Incoming\")
 
    End If
 
Kill ("D:\Euromaster\Source\import.txt")
Kill ("D:\Euromaster\Source\*.doc")
MsgBox ("Purge du dossier Source OK")
 
Application.DisplayAlerts = False
Application.Quit
 
Else
   MsgBox ("Votre fichier source n'a pas été copier dans le répertoire Source")
   Application.Quit
   Exit Sub
End If
 
Exit Sub
 
Err: MsgBox ("Aucune corresponce SAP pour le Code Dealer:" & Mid$(ligne, 34, 3) & vbCrLf & vbCrLf & "Vérifier que le Code Dealer est bien référencé dans SAP")
SetAttr ("D:\Euromaster\Source\import.txt"), vbHidden
Kill ("D:\Euromaster\Source\*.doc")
Kill ("D:\Euromaster\Backup\*.doc")
MsgBox ("1 - FICHIER BACKUP SUPPRIME" & vbCrLf & vbCrLf & "2 - Purge du dossier Source OK")
Application.Quit
 
End Sub

**sabzzz** · 26/04/2010, 17h41

bonjour Loupire,

il faut declarer les variables LeTest et Répertoire au niveau module

Code :

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

1
2
Dim LeTest As Boolean
Dim Répertoire

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub TestExists()
Dim fso As Object, Dossier As Object, Files As Object, File As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fso.GetFolder(Répertoire)
    Set Files = Dossier.Files
    If Files.Count <> 0 Then
        For Each File In Dossier.Files
         If File.Name Like "*.doc" Then LeTest = True
        Next
    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
Sub Import_Euromaster_6()
Dim ligne As String
Dim NbLigne As Long
Dim i As Long
Dim r As Long
Dim StartTab1 As Long
Dim EndTab1 As Long
Dim mon_tableau() As String
Dim MaRef As Variant
Répertoire = "D:\Euromaster\Source"
'TEST 1
TestExists
If LeTest Then
'la suite

**Pierre Fauconnier** · 26/04/2010, 17h45

Bonjour

Obligé d'utiliser le FileSystemObject? Car un simple dir permet de tester l'existence d'un fichier.

**Loupire** · 26/04/2010, 17h55

Merci !

Je pense avoir trouvé une parade :

Code :

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

1
2
3
4
5
Dim toto As String
toto = "D:\Euromaster\Source\*.doc"
If Dir(toto, vbNormal Or vbReadOnly Or vbHidden Or vbSystem Or vbArchive) = "" Then
        Call MsgBox("Votre fichier source n'a pas été copier dans le répertoire Source")
Else

Après mes tests il me semble que ça fonctionne bien !

Mais quoi qu'il en soit je vais essayer votre bout de code ne serait ce que pour ma culture personnelle en VB !

Je vous tiens informé demain,

Problème avec (fso.FileExists(filespec)) + * [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager