FileSearch sur Excel 2007

[julien 07]

Bonjour tout le monde,

Voilà, j'ai un problème avec une macro qui fonctionne bien sur les versions antérieurs mais plus sous Excel 2007 à cause d'un FileSearch qui n'est plus reconnu. J'ai essayé avec le complément donné sur le site silkyroad mais j'avoue que mon niveau sous VBA ne me permet pas de transposer l'exemple à mon cas.

Voici le code ma macro (encore merci au forum pour l'aide apportée à sa réalisation) :

Sub parcours_rep_copie()

'Definition des variables

Dim N As Long
Dim Chemin As String
Dim Fin As Long
Dim W_BK As Workbook

'Supprimer les informations initial

Range("A2:AD5000").ClearContents

'Definition du chemin du repertoire

Chemin = "C:\Documents and Settings\Administrateur\Bureau\incident ep\lot01"
DoEvents
Application.ScreenUpdating = False
Set W_BK = ThisWorkbook
With Application.FileSearch
    .LookIn = Chemin
    .FileType = msoFileTypeExcelWorkbooks
    .Filename = "incident"
    .SearchSubFolders = False
        On Error Resume Next
        If .Execute > 0 Then
            For N = 1 To .FoundFiles.Count
            Fin = W_BK.Sheets("Feuil1").[A65536].End(xlUp).Row + 1
                Workbooks.Open (.FoundFiles(N))
                
                    With ActiveWorkbook
                    'Recopie de la selection sur la feuil1
                    .Sheets("result").Range("A2:AE15").Copy W_BK.Sheets("Feuil1").Cells(Fin, 1)
                    .Close False
                End With
            Next N
        End If
End With
Application.ScreenUpdating = True

'Faire un fichier texte

'ouvrir le document fichier texte
ChDir _
        "C:\Documents and Settings\Administrateur\Bureau\incident ep\lot01\Fichier texte base"
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\Administrateur\Bureau\incident ep\lot01\Fichier texte base\base texte.xls"
 
 ' Nettoyer le fichier texte
 
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete
    
'Copier coller en format texte

    Windows("base_lot_01.xls").Activate
    
     'nettoyer les cellules vides
    
        For i = Range("B65536").End(xlUp).Row To 1 Step -1
    If Range("B" & i) = 0 Then Range("B" & i).EntireRow.Delete
    Next i
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
       
    'Coller special
    
    Windows("base texte.xls").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\Administrateur\Bureau\incident ep\lot01\Fichier texte base\base_lot_01.txt" _
        , FileFormat:=xlText, CreateBackup:=False
        
'Fermer les fichiers

Windows("base_lot_01.xls").Activate
ActiveWorbook.Save
ActiveWorbook.Close
Windows("base texte.xls").Activate
ActiveWorkbook.Save
ActiveWorbook.Close
Windows("base texte.txt").Activate
ActiveWorkbook.Save
ActiveWorbook.Close
Windows("base_lot_01.txt").Activate
ActiveWorbook.Save
ActiveWorbook.Close
End Sub

Voilà, si quelqu'un peux m'expliquer comment faire pour adapter sous 2007 la fonction FileSearch, je lui en serait fort reconnaissant.

Merci d'avance.

Julien

 

[fred65200]

Re : FileSearch sur Excel 2007

bonjour
un lien utile pour FileSearch version 2007.
Cordialement

 

[julien 07]

Re : FileSearch sur Excel 2007

Bonjour fred65200 et merci de ta réponse.

J'ai déjà essayé avec ce lien, j'ai suivi la procédure et j'ai essayé de reprendre l'exemple pour comprendre comment ça marche mais le problème c'est que le ClFileSearch.ClasseFileSearch n'est pas reconnût, du coup ça ne marche pas et je ne comprend pas pourquoi.

Voilà, n'y aurait-il pas une autre manière de procéder ?

Julien

 

[yanclout]

Re : FileSearch sur Excel 2007

Bonjour,

Voilà un bout de code que j'utilise dans une de mes applications Excel 2007 pour rechercher des fichiers .pdf et les ouvrir une fois trouvée...

J'espère que ça pourra t'inspirer....


Sub RechercheFichier(LeDossier As String, Nom As String, SousDossiers As Boolean)
Dim fso As Object, Dossier As Object
Dim sousRep As Object
Dim file As Object
Dim stAppName As String
Dim Nomfile As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(LeDossier)

For Each file In Dossier.Files
Nomfile = file.Name
If Nomfile = Nom Then
stAppName = "C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe /p /h " & file
Process = Shell(stAppName, 1)
Exit Sub
End If
Next

'traitement récursif des sous dossiers
If SousDossiers Then
For Each sousRep In Dossier.SubFolders
Call RechercheFichier(sousRep.Path, Nom, True)
Next sousRep
End If

Set fso = Nothing
Set Dossier = Nothing
End Sub

Bonne chance

 

[julien 07]

Re : FileSearch sur Excel 2007

Bonjour Yanclout,

merci pour ton exemple, je vais essayer de m'en inspirer pour régler mon problème.

Julien