XL 2010 Sélectionner des fichiers avec des noms différents

[etpisculrien]

Bonjour à tous,

Une nouvelle fois je reviens vers vous car vous m'avez toujours bien conseillé...
Voilà, je souhaiterais trouver le moyen de récupérer le nom des fichiers dans un dossier mais ces fichiers ont des nom différents. En clair, je souhaite récupérer les noms et chemins de tous les fichiers qui commencent par "Intervention", "Rapport" et "Compte".

J'avais penser à un code du genre (mais ça fonctionne pas) :

Dim Fichier As Variant, Chemin As String

Chemin = "\\999.99.9.9\babar\truc\
Fichier = Array(Dir(Chemin & "Interventions*.xlsx"), Dir(Chemin & "Rapports*.xlsx"))

Do While Fichier <> ""

blablablabla
Fichier = Dir
Loop

j'ai pensé à Array mais je ne maitrise pas très bien :s
Si vous aviez un moyen de m'aider ou une autre piste, ce serait cool

 

[job75]

Bonjour etpisculrien,

Vous pouvez utiliser cette manière de faire :

Sub RechercheFichiers()
Dim chemin$, a(), ub As Byte, i As Byte, fichier, n&, b$()
chemin = ThisWorkbook.Path & "\" 'à adapter
a = Array("Intervention", "Rapport", "Compte") 'liste à adapter
ub = UBound(a)
fichier = Dir(chemin & "*.xlsx")
While fichier <> ""
  For i = 0 To ub
    If fichier Like a(i) & "*" Then
      n = n + 1
      ReDim Preserve b(1 To n)
      b(n) = fichier 'chemin & fichier
    End If
  Next
  fichier = Dir
Wend
If n Then [A2].Resize(n) = Application.Transpose(b) 'si n <= 65536
Range("A" & n + 2 & ":A" & Rows.Count) = ""
End Sub

Application.Transpose ne fonctionne pas au delà de 65536 lignes, si c'est le cas utiliser :

If n Then
  ReDim a(1 To n, 1 To 1)
  For i = 1 To n
    a(i, 1) = b(i) 'transposition
  Next
  [A2].Resize(n) = a 'restitution
End If
Range("A" & n + 2 & ":A" & Rows.Count) = ""

A+

 

[Paf]

bonjour,

peut-être quelque chose comme:

Fichier = Dir(Chemin)

Do While Fichier <> ""
If Fichier Like "Intervention*.xlsx" Or Fichier Like "Rapport*.xlsx" Or Fichier Like "Compte*.xlsx" Then
    blablablabla
End If
Fichier = Dir
Loop

A+

Edit : bonjour job75

 

[job75]

Re, salut Paf,

Pour que la casse soit ignorée ajoutez Option Compare Text tout en haut du module de la macro.

A+

 

[job75]

Re,

Plus sophistiqué, en utilisant les expressions régulières :

Sub RechercheFichiers()
Dim chemin$, o As Object, fichier$, n&, a$()
chemin = ThisWorkbook.Path & "\" 'à adapter
Set o = CreateObject("vbscript.regexp")
o.Pattern = "^Intervention|^Rapport|^Compte" 'liste à adapter (^ pour dire commence par)
fichier = Dir(chemin & "*.xlsx")
While fichier <> ""
  If o.Execute(fichier).Count Then
    n = n + 1
    ReDim Preserve a(1 To n)
    a(n) = fichier 'chemin & fichier
  End If
  fichier = Dir
Wend
If n Then [A2].Resize(n) = Application.Transpose(a) 'si n <= 65536
Range("A" & n + 2 & ":A" & Rows.Count) = ""
End Sub

A+

 

[etpisculrien]

Bonjour à tous,
Tout d'abord, merci à tous de vos réponses, l'esprit "aide" du forum est bien toujours présent
J'ai regardé vos différentes réponses et le gagnant est........ Paf! et Job75 (pour sa proposition du "Option Compare Text") Cette solution est plus simple et vu que je suis un gros feignant, ça m'allait très bien
Merci tout de même à Job75 pour les autres possibilités, cela m'apprend toujours un peu plus

Passez de bonnes fêtes à tous

 

[job75]

Bonjour etpisculrien, le forum,

Option Compare Text n'a aucun effet sur les expressions régulières.

Pour ignorer la casse le plus simple est d'écrire :

Sub RechercheFichiers()
Dim chemin$, o As Object, fichier$, n&, a$()
chemin = ThisWorkbook.Path & "\" 'à adapter
Set o = CreateObject("vbscript.regexp")
o.Pattern = "^intervention|^rapport|^compte" 'liste à adapter (^ pour dire commence par)
fichier = Dir(chemin & "*.xlsx")
While fichier <> ""
  If o.Execute(LCase(fichier)).Count Then
    n = n + 1
    ReDim Preserve a(1 To n)
    a(n) = fichier 'chemin & fichier
  End If
  fichier = Dir
Wend
If n Then [A2].Resize(n) = Application.Transpose(a) 'si n <= 65536
Range("A" & n + 2 & ":A" & Rows.Count) = ""
End Sub

Edit : la solution de Paf avec la suite des 3 Like est simple mais c'est vous au post #1 qui avez parlé d'un Array.

Et c'est quand même mieux s'il y a une dizaine de mots à chercher...

Bonne journée.