Discussion :

[GuiJenn34]

Bonjour,

Je recherche un code VBA ou l'on peut rechercher un fichier (tout type, PDF Excel, Word,etc...) dans un sous répertoire et l'ouvrir.

Exemple ouvrir le fichier 8101063347.pdf
dans le répertoire --> "C:\FICHIERS\Recouvrement CLIENTS\VALIDATION\Factures Fournisseurs\2015\03 - Mars\06"
Mais en indiquant dans le code VBA --> "C:\FICHIERS\Recouvrement CLIENTS\VALIDATION\Factures Fournisseurs\"
Car tous les fichiers se trouve ici mais dans des répertoire différents.

Ici c'est un PDF, je souhaiterai la même chose pour n’importe quel fichier.
Et bien sur le code le moins compliqué possible pour que cela soit simple à modifier dans le cas échéant.

Merci à vous

[kiki29]

Salut, regarde ceci : Liste des fichiers d'un dossier : Win 32/64 Bits qui permet de lister dles fichiers d'un dossier, avec recherche récursive ou non, via les APIs, qui propose une fenêtre de recherche pour saisir le/les types de fichiers ( ou fichiers ) à rechercher.
A adapter à ton contexte pour l'ouverture, avec par exemple un ShellExecute sur le chemin des fichiers, ou un lien hypertexte sur le /les chemins des fichiers.

Code :

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

1
2
3
4
5
6
7
8
9
Option Explicit
 
Sub Tst()
Dim sFichier As String, WsShell As Object
    sFichier = "C:\Essais\catalogue.pdf"
    Set WsShell = CreateObject("WScript.Shell")
    WsShell.Run "AcroRd32 " & sFichier
    Set WsShell = Nothing
End Sub

[GuiJenn34]

C'est pas tout à fait ce que je recherche.

En gros je souhaiterai une Macro qui m'ouvre le fichier (PDF, Word Excel, etc...) en le recherchant dans un sous répertoire au nom inconnue, ou le nom à changé.

Exemple :
Fichier : F15010540.pdf
Chemin : \\Sr8v-fireblade\appli\FICHIERS\Recouvrement CLIENTS\VALIDATION\Factures Fournisseurs\2015\02 - Février\03\

Car j'ai le nom du fichier dans stocké dans une cellule, je sais l'ouvrir si je connais exactement où il se trouve, mais des fois cela ne fonctionne pas car il ne se trouve pas dans le bon sous-répertoire.
Mais la chose qui est sure c'est qu'il est bien dans le répertoire principal à savoir : \\Sr8v-fireblade\appli\FICHIERS\Recouvrement CLIENTS\VALIDATION\Factures Fournisseurs\.

Merci par avance

[Marc-L]

Bonjour,

voici ma fonction renvoyant par défaut le premier fichier correspondant à partir d'un dossier racine :

Code :

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

1
2
3
4
5
6
7
8
9
Function DocScan(ByVal DOC, Optional ALL As Boolean)
  DOC = Split(CreateObject("WScript.Shell").Exec("cmd /c Dir """ & DOC & """ /B /S").StdOut.ReadAll, vbCrLf)
  If ALL Then
      If UBound(DOC) > 0 Then ReDim Preserve DOC(UBound(DOC) - 1)
  Else
      If UBound(DOC) > -1 Then DOC = DOC(0) Else DOC = ""
  End If
         DocScan = DOC
End Function

En activant son paramètre ALL (True), elle retourne alors une variable tableau de toutes les correspondances.


Et une fois le fichier trouvé, utiliser ma procédure DocOpen …

_____________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

_____________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

[GuiJenn34]

Je ne sais pas ou placer ce code.

Dans mon code VBA j'ai :

Code :

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

1
2
3
4
5
6
7
8
9
Sub Ouvrir_Facture()
 
    If Sheets("Paramétrage").Range("B2").Value = "" Then
    Exit Sub
    End If
 
    ThisWorkbook.FollowHyperlink Sheets("Paramétrage").Range("B2")
 
End Sub

Dans la celluele B2 j'ai : =SIERREUR("\\Sr8v-fireblade\appli\FICHIERS\Recouvrement CLIENTS\VALIDATION\Factures Fournisseurs\"&TEXTE('Pièces Grossistes'!D9;"aaaa")&"\"&TEXTE('Pièces Grossistes'!D9;"mm")&" - "&TEXTE('Pièces Grossistes'!D9;"mmmm")&"\"&TEXTE(SI(GAUCHE(TEXTE('Pièces Grossistes'!D9;"jjj");3)="ven";TEXTE('Pièces Grossistes'!D9;"jj")+3;SI(GAUCHE(TEXTE('Pièces Grossistes'!D9;"jjj");3)="sam";TEXTE('Pièces Grossistes'!D9;"jj")+2;TEXTE('Pièces Grossistes'!D9;"jj")+1));"00") &"\"&'Pièces Grossistes'!D10&".pdf");"")

En gros ce qui correspond à :
1- =SIERREUR("\\Sr8v-fireblade\appli\FICHIERS\Recouvrement CLIENTS\VALIDATION\Factures Fournisseurs\" Ma base racine des fichier
2- &TEXTE('Pièces Grossistes'!D9;"aaaa")&"\"&TEXTE('Pièces Grossistes'!D9;"mm")&" - "&TEXTE('Pièces Grossistes'!D9;"mmmm")&"\"&TEXTE(SI(GAUCHE(TEXTE('Pièces Grossistes'!D9;"jjj");3)="ven";TEXTE('Pièces Grossistes'!D9;"jj")+3;SI(GAUCHE(TEXTE('Pièces Grossistes'!D9;"jjj");3)="sam";TEXTE('Pièces Grossistes'!D9;"jj")+2;TEXTE('Pièces Grossistes'!D9;"jj")+1));"00") &"\" aller au sous répertoire
3 - &'Pièces Grossistes'!D11");"") Le nom de mon fichier (Ici un PDF)


J'ai le même principal pour d'autre ouverture de fichiers différents. Je voudrais intégrer le code qui passe de l'atape 1 à 3. C'est a dire de lire le/les fichiers dans un dossier sans écrire le chemin des sous-dossier.
Je connais pas très bien le VBA, la méthode est surement bonne mais je ne sais pas comment l'adapter (facilement) à mon/mes code existant.

[Marc-L]

Voici un exemple d'ouverture du document Facture2015-01-012.pdf à partir du dossier D:\FacturePDF
même s'il est enregistré dans le sous-répertoire D:\FacturePDF\2015 :

DocOpen DocScan("D:\FacturePDF\Facture2015-01-012.pdf") …

Et s'il ne se passe rien, le fichier n'existe pas alors dans cette arborescence.
Évidemment la procédure DocOpen et la fonction DocScan doivent se situer dans le même module …

[GuiJenn34]

Il faut mettre le code comme ceci :

Sub Ouvrir_Facture()

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Function DocScan(ByVal DOC, Optional ALL As Boolean)
DOC = Split(CreateObject("WScript.Shell").Exec("cmd /c Dir """ & DOC & """ /B /S").StdOut.ReadAll, vbCrLf)
    If ALL Then
    If UBound(DOC) > 0 Then ReDim Preserve DOC(UBound(DOC) - 1)
    Else
    If UBound(DOC) > -1 Then DOC = DOC(0) Else DOC = ""
    End If
    DocScan = DOC
End Function
 
    DocOpen DocScan("\\Sr8v-fireblade\appli\FICHIERS\Recouvrement CLIENTS\VALIDATION\Factures Fournisseurs\" & Range("D10") & ".pdf")
 
End Sub

Car cela ne fonctionne pas.

[Heureux-oli]

Salut,

Jette un œil là : http://access.developpez.com/sources...ercheRecursive

[Marc-L]

Car cela ne fonctionne pas.

La fonction ne doit pas être mélangée dans une procédure !

Code :

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

1
2
3
4
5
6
7
Function NomFonction()
    code de la fonction
End Function
 
Sub NomProcedure()
    code de la procédure
End Sub

_____________________________________________________________________________________________________
Si déboguer est l’art de corriger les bogues, alors programmer est l’art d’en faire !

[GuiJenn34]

Bonjour Marc-L,

J'ai fait comme tu m'as dis de faire, mais cela ne fonctionne pas :

Code :

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

1
2
3
4
5
6
7
8
9
Function DocScan(ByVal DOC, Optional ALL As Boolean)
    DOC = Split(CreateObject("WScript.Shell").Exec("cmd /c Dir """ & DOC & """ /B /S").StdOut.ReadAll, vbCrLf)
    If ALL Then
    If UBound(DOC) > 0 Then ReDim Preserve DOC(UBound(DOC) - 1)
    Else
    If UBound(DOC) > -1 Then DOC = DOC(0) Else DOC = ""
    End If
    DocScan = DOC
End Function

Code :

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

1
2
3
Sub Ouvrir_Facture()
    DocOpen DocScan("\\Sr8v-fireblade\appli\FICHIERS\Recouvrement CLIENTS\VALIDATION\Factures Fournisseurs\" & Range("D10") & ".pdf")
End Sub

Voici le message d'erreur que j'ai :

[Marc-L]

Apparemment tu as oublié de copier la procédure DocOpen pourtant en lien dans le post #4, comme indiqué dans le post #6 …

[GuiJenn34]

Merci à toi Marc-L,

C'est un peu plus long le temps de recherche mais ça fonctionne dans un seul module j'ai mis :

Code :

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

1
2
3
4
5
6
7
8
9
Function DocScan(ByVal DOC, Optional ALL As Boolean)
  DOC = Split(CreateObject("WScript.Shell").Exec("cmd /c Dir """ & DOC & """ /B /S").StdOut.ReadAll, vbCrLf)
  If ALL Then
      If UBound(DOC) > 0 Then ReDim Preserve DOC(UBound(DOC) - 1)
  Else
      If UBound(DOC) > -1 Then DOC = DOC(0) Else DOC = ""
  End If
         DocScan = DOC
End Function

et :

Code :

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

1
2
3
4
5
Sub DocOpen(Fichier$)
    On Error Resume Next
    CreateObject("WScript.Shell").Run _
    CreateObject("Scripting.FileSystemObject").GetFile(Fichier).ShortPath
End Sub

et :

Code :

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

1
2
3
4
Sub Ouvrir_Facture2()
    DocOpen DocScan("\\Sr8v-fireblade\appli\FICHIERS\Recouvrement CLIENTS\VALIDATION\Factures Fournisseurs\" _
    & Range("D10") & ".pdf")
End Sub

[Marc-L]

C'est un peu plus long le temps de recherche

Le temps est allongé déjà à cause du réseau, c'est rapide en local …

Sinon en plus véloce il y aurait le recours aux APIs comme le lien de Doug (kiki29, salut Philippe !).
Il y a aussi la fonction VBA Dir à jouer en récursif; éviter FileSystemObject souvent bien plus long …