macro recherche fichier

[julos08]

Bonjour a tous,

J'ai une macro qui me trouve dans mon lecteur c: tous les dossiers portant le nom que je saisie prealablement ( merci a klauss).

voila la macro

Dim fso As Object, fld As Object, iCounter As Integer, stComp As String

Sub StartScan()
'coPath est le chemin du dossier dans lequel on effectue la recherche
Const coPath = 'C:\\'
stComp = vbNullString: iCounter = 0
Do While Len(stComp) = 0
stComp = InputBox('Entrez le nom à chercher')
Loop
stComp = '*' & LCase(stComp) & '*'
Set fso = CreateObject('scripting.filesystemobject')
Application.Cursor = xlWait
Call ListFld(coPath)
Application.Cursor = xlNormal
MsgBox 'Recherche terminée !'
End Sub

Sub ListFld(stInput As String)
On Error Resume Next
For Each fld In fso.getfolder(stInput).subfolders
If LCase(fld.Name) Like stComp Then
iCounter = iCounter + 1

Range('A' & iCounter).Value = fld.Path
End If
Call ListFld(fld.Path)
DoEvents
Next fld
End Sub

Maintenant si cest possible jaimerai que le texte quil maffiche dans mes cellules est un lien me permetant d'ouvrir le dossier contenant
par exemple je fai une recherche pour nouveau dossier dans c:, dans mes cellules de la colonne A il maffiche tous les dossiers quil trouve portant ce nom et se trouvant dans le c:
jaimerai que quand je clic sur une des cellules il mouvre le dossier dans windows.

Merci a tous

@++

julos08

 

[julos08]

personne pour maider

Merci d'avance

 

[dg62]

Bonsoir

Il ne faut pas capituler !

Les débuts de semaine sont parfois difficiles

ça ira mieux demain ou peut-être cette nuit car il y a des couches tard chez les XLDnautes.

 

[julos08]

Ok pas de probleme je suis patient.

 

[kloss]

Re-Salut julos
Pas de solution en formule selon moi J'ai essayé ça :
=hyperlink('c:[slash]windows[slash]explorer.exe c:[slash]mondossier';'The Link') mais la fonction hyperlink n'admet pas les arguments qu'on passe à l'exécutable.
En revanche, on peut toujours écrire ça :

Function GoToRep (stFldSpec as String)
If fso.folderexists(stFldSpec) Then
    ActiveWorkbook.FollowHyperlink stFldSpec
End If
End Function

Elle sera déclenchée par ces lignes dans la feuille appropriée :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call GoToRep(ActiveCell.Value)
End Sub

Pas très élégant comme solution mais ça fonctionne
NB 1 : il faut évidemment que la variable fso soit initialisée
NB 2 : Dans l'autre code (plus haut), libérer les variables objet inutiles
++
Kloss

Message édité par: kloss, à: 07/03/2005 23:06

Message édité par: kloss, à: 07/03/2005 23:07

 

[kloss]

Ah mais si je suis nul ça marche en formule avec ça :

=hyperlink('c:\\mondossier';'The link')

Pas besoin de passer par explorer.exe... Bon ensuite modifier la procédure ça n'est pas compliqué : il faut écrire qqch du genre :

range('A' & icounter).formula = '=hyperlink(' & chr(34) & fld.path & chr(34) & ';' & chr(34) & fld.name & chr(34) & ')'

(Je n'ai pas vérifié ça mais ça donne l'idée).
++

kloss

NB: si ton office n'est pas en anglais, hyperlink doit s'appeler hyperlien ou lienhypertexte ou un truc dans le genre

Message édité par: kloss, à: 07/03/2005 23:45

 

[julos08]

Merci kloss ca ma aiguillé jai trouvé une solution adequate.

Par contre tu ma filé une macro pour la recherche de dossier jai essayé de la modifié pour trouver des fichiers ( ex:. xls ou .doc) mais jai pas trouver si tu pouvais m'aider.

D'avance merci

 

 

[julos08]

si par hasard kloss passait dans le coin lol

 

[kloss]

Bonsoir Julos08, bonsoir à tout le forum
* Pour travailler non plus sur les sous-dossiers d'un dossier, mais sur ses fichiers, il faut utiliser non pas la propriété SUBFOLDERS, mais la propriété FILES (peu étonnant btw)
* La comparaison sur l'extension peut être obtenue avec la fonction GETEXTENSIONNAME(monfichier.ext)
D'une manière générale, il est utile d'utiliser Windows Script pour la manipulation de fichiers (même si on pourrait se débrouiller sans, par exemple avec la fonction DIR de vba). On trouve tout ce qu'on veut comme exemples dans l'aide msdn.
Dis moi si tu peux t'en sortir seul ou si tu as besoin d'une macro toute faite (j'ai peu de temps cette semaine...)
Tiens nous au courant
++
kloss

 

[julos08]

Salut kloss,

ok je vais voir si jarrive a me debrouillé je te redi koi

Merci

@++
julos08

 

[julos08]

Desole mais mes competences en vba sont minimes et je narrive pas a retaper le code pour la recherche de fichiers.

@++
julos08

 

[kloss]

Hello
Tu as un exemple avec la propriété subfolders et la fonction getextensionname dans ce post :
Lien supprimé
En mixant ça avec la procédure de recherche des sous-dossiers tu devrais y arriver. Si non, j'espère qu'un autre XLDnaute pourra t'aider parce que ce WE j'ai vraiment peu de temps. Au pire je me penche sur la question au courant de la semaine prochaine.
++
Kloss

 

[julos08]

bonsoir kloss

Jai trouvé une solution dis moi ce que tu en pense
Sub ListerFichier()

Dim Cel As Range, Trouve As Long



With ActiveSheet
.UsedRange.Delete
Set Cel = .[A2]
End With
With Cel
.Value = 'Chemin fichier'
.Offset(0, 1) = 'Taille'
.Offset(0, 2) = 'Date/Heure'
With .Resize(1, 3)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.Offset(1, 0) = 'c:\\'
End With
Set Cel = Cel.Offset(2, 0)

With Application.FileSearch
.NewSearch
.LookIn = 'c:\\'
.Filename = '*.xls'
.SearchSubFolders = True
.Execute msoSortByFileName
For Trouve = 1 To .FoundFiles.Count
Cel.Value = Mid(.FoundFiles(Trouve), InStrRev(.FoundFiles(Trouve), '\\') + 1)
Set Cel = Cel.Offset(1, 0)
Next Trouve
End With

ActiveSheet.UsedRange.EntireColumn.AutoFit
End Sub

le truc maintenant ca serai de pouvoir ouvrir le dossier contenant de windows quand on clic sur le nom du fichier.


Merci

@++
julos08

 

[ChTi160]

bonsoir'julos08'
bonsoir le fil
je pense que tu trouveras de nombreux exemples en faisant une recherche sur l'ancien forum
tu tapes coller lien Hypertext
ou liens Hypertext

j'ai dans mes archives un code qui te permet de lister par types celà peut ,peut être te servir

Sub ChercheXLB() 
typeFile = InputBox('Quel type de fichier?' & Chr(13) & 'Taper l'extension!'Â'Â')
Worksheets.Add
ActiveSheet.Name = 'Liste des fichiers' & ' ' & typeFile
[A1].Value = 'Liste des fichiers' & ' ' & typeFile
Selection.Font.Bold = True

Dim LstFile As Long
With Application.FileSearch
.Filename = '*.' & typeFile
.LookIn = 'C:\\Documents and Settings\\??????\\Mes documents\\' 'mettre à jour
.SearchSubFolders = True
For LstFile = 1 To .Execute(msoSortByFileName)
ActiveSheet.Cells(LstFile + 1, 1).Value = .FoundFiles(LstFile)
Next LstFile
End With
End Sub

Message édité par: ChTi160, à: 11/03/2005 22:58