[VBA-E] passer fichier inexistant

Version imprimable

voila j'ai écrit il y a quelque temps pourobtenir un programme permettant de récupérer des valeurs dans d'autres fichiers vous m'avez beaucoup aidé, sa marchait très bien mais en sur les 2000 fichier 200 sont inexistant et ilme demandais à chaque fois de le retrouver, donc j'ai voulu incorporer une fonction pour seulement passer la ligne
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub Macro1() Dim i As Integer For i = 3 To 2000 If ='C:\...\" & Cells(i, 2).Value & "\" & Cells(i, 7).Value & "\" & "[" & Cells(i, 7).Value & ".XLS" & "]Feuil1'!R22C8" = false Then 'rien Else Cells(i, 17).Select ActiveCell.FormulaR1C1 = _ "='C:\...\" & Cells(i, 2).Value & "\" & Cells(i, 7).Value & "\" & "[" & Cells(i, 7).Value & ".XLS" & "]Feuil1'!R22C8" End If Next i End Sub
mais je ne connais pas la synthaxe "if lien=false then rien."

20/04/2007, 11h00
gruget

Bonjour
regarde avec la fonction DIR je crois quelle fait ce que tu veux
rémi

Si c'est bien de cette ligne dont tu parles, essaie avec empty

Code:

1
2
3
4
5
6
7
If Cells(i, 2).Value = Empty or Cells(i, 7).Value = Empty or Cells(i, 7).Value = empty Then
        'Le fichier n'existe pas
    else
        Cells(i, 17).Select
        ActiveCell.FormulaR1C1 = _
        "='C:\...\" & Cells(i, 2).Value & "\" & Cells(i, 7).Value & "\" & "[" & _
         Cells(i, 7).Value & ".XLS" & "]Feuil1'!R22C8"

Tiens, un code plus intelligent
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub OuvrirSiLeFichierExiste() Call OuvrirUnClasseur("D:\xls\", "LeFichier.xls") End Sub Sub OuvrirUnClasseur(Chemin, NomFich) Dim fso As New FileSystemObject Dim Rep As Folder Set Rep = fso.GetFolder(Chemin) Wk = Chemin & NomFich If fso.FileExists(Wk) Then Workbooks.Open Filename:=Wk DoEvents 'Laisse le temps au système d'ouvrir le fichier avant de passer au suivant End If Set Rep = Nothing End Sub
Ligne en bleu à placer dans ta boucle, et à la place de ton test ;)

Edit
Penser à valider la référence "Microsoft Scripting runtime" -> Editeur VB -> Outils -> Références

20/04/2007, 15h24
ferronimus

Merci pour vos réponse, mais je vais voir sa que lundi
ferronimus
23/04/2007, 10h10
ferronimus

ta première idée ouskel'n'or ne fonctionne pas, excel me demande toujours d'ouvrir les fichier manuellement, je vais tenter l'autre
23/04/2007, 10h20
ouskel'n'or

Curieux, chez moi ça fonctionne.
Peux-tu mettre le code que tu as utilisé ? (quelles modifs par rapport au mien)
A+

pour ta 1er méthode j'ai mis:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro1()
 
Dim i As Integer
 
For i = 1 To 1981
     If Cells(i, 2).Value = Empty Or Cells(i, 7).Value = Empty Or Cells(i, 7).Value = Empty Then
    Else
        Cells(i, 21).Select
        ActiveCell.FormulaR1C1 = _
        "='x:\...\" & Cells(i, 2).Value & "\" & Cells(i, 7).Value & "\" & "[FICHE_INCIDENT_" & _
        Cells(i, 7).Value & ".XLS" & "]Feuil1'!R21C8"
            End If
Next i
End Sub

mais empty sa vérifie si il y quelquechose dans la cellule pas si le chemin former par l'association de cellule est vrai?
et pour la seconde,j'ai quelquepeu modifier et j'obtien cela

Code:

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
Sub Macro2()
 
Dim i As Integer
 
For i = 1 To 1981
     If OuvrirUnClasseur("='x:\...\" & Cells(i, 2).Value & "\" & Cells(i, 7).Value & "\", "FICHE_INCIDENT_" & Cells(i, 7).Value & ".XLS") Then
    Else
        Cells(i, 21).Select
        ActiveCell.FormulaR1C1 = _
        "='x:\...\" & Cells(i, 2).Value & "\" & Cells(i, 7).Value & "\" & "[FICHE_INCIDENT_" & Cells(i, 7).Value & ".XLS" & "]Feuil1'!R21C8"
     End If
Next i
End Sub
 
Function OuvrirUnClasseur(Chemin, NomFich)
Dim fso As New FileSystemObject
Dim Rep As Folder
    Set Rep = fso.GetFolder(Chemin)
        Wk = Chemin & NomFich
        If fso.FileExists(Wk) Then
           Workbooks.Open Filename:=Wk
           DoEvents 'Laisse le temps au système d'ouvrir le fichier avant de passer au suivant
        End If
    Set Rep = Nothing
End Function

avec une erreur 76 ( chemin introuvable) sur Set Rep = fso.GetFolder(Chemin)

23/04/2007, 11h02
ouskel'n'or

Je t'ai dit que la seconde méthode était plus mieux sioux...
As-tu essayé d'afficher Chemin dans la procédure OuvrirUnClasseur ?
Le pb vient nécessairement de là, auquel cas tu vas devoir revoir ta formule insérée. Je regarde mais dis-moi pour chemin.
A+
23/04/2007, 11h18
ferronimus

en effet mon chemin et mon nom de fichier sont complètement faux sans doute une erreur de quillemetou parenthèze
23/04/2007, 11h30
ouskel'n'or

Ta "formula" est pour le moins curieuse...
Tu devrais décomposer ta ligne
Chemin = ....
Chemin = Chemin & ...
NomFich = ... & ".xls"
tcétesrats ! ;)
A+
23/04/2007, 11h39
ferronimus

je viens de modifier des guillemet, le chemin est valide, par contre, lorsque le fichier existe ta fonction ouvrirunclasseur ouvre le classeur, il tente de copier la valeur dans ce meme fichier et pas dans le mien puis plante
23/04/2007, 14h18
ouskel'n'or

Ça, c'est aut'chose... Je regarde ton code

Oui. Là, tu as fais n'importe quoi ;)
Pour de vrai, tu dois transformer la macro en fonction, et que la fonction te retourne un boolean

Code:

1
2
3
4
5
6
7
For i = 1 To 1981
     If OuvrirUnClasseur(Chemin, NomFich) Then
        Cells(i, 21).Select
        ActiveCell.FormulaR1C1 = _
        "='x:\...\" & Cells(i, 2).Value & "\" & Cells(i, 7).Value & "\" & "[FICHE_INCIDENT_" & Cells(i, 7).Value & ".XLS" & "]Feuil1'!R21C8"
     End If
Next i

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function OuvrirUnClasseur(Chemin, NomFich)
Dim fso As New FileSystemObject
Dim Rep As Folder
    Set Rep = fso.GetFolder(Chemin)
        Wk = Chemin & NomFich
        If fso.FileExists(Wk) Then
           Workbooks.Open Filename:=Wk
           DoEvents 'Laisse le temps au système d'ouvrir le fichier avant de passer au suivant
           OuvrirUnClasseur = True
         'else
           'OuvrirUnClasseur = False
        End If
    Set Rep = Nothing
End Function

Pas testé mais ça devrait faire l'affaire
A+