Recherche multiple dans classeurs fermés

Fermé
damdamdeo44 - 10 août 2013 à 18:07
lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 - 11 août 2013 à 16:16
Bonjour,

je reviens vers vous car vous avez déjà été d'une grande aide .

J'ai un nouveau problème. j'ai consulté pas mal de forum et de fichier aide Microsoft mais à chaque fois ça plante.

Voici les fondements :

1 - Sur un serveur j'ai plusieurs rep avec des fichiers dedans. seuls un fichier précis par rep m'intéresse. il possède la même syntaxe juste le dernier mot diffère.
je voudrais une macro qui m'ouvre un à un les fichiers précis où seul la fin diffère pour en récupérer la ligne en fonction de critères définis dans mon usrf.



J'ai dans un premier temps fais un scan pour qu'il écrive les fichiers en question sur feuil1.
jusque là ça le fais.
voici le code :
Option Explicit
Dim i, U As Long
Dim checkf
Dim Name As String



Sub Test()
Dim Chemin As String, Dossier As Object, SousDossier As Object, Fichier As Object

Sheets("Feuil1").Cells.Clear

Chemin = "\\serveur\Projets\P736\Echange\avant\"

i = 11

Application.ScreenUpdating = False

Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
    For Each Fichier In Dossier.files

        i = i + 1
    Next

ListeFichier (Chemin)

Application.ScreenUpdating = True

End Sub
Function ListeFichier(Chemin As String) As String
Dim Dossier As Object, SousDossier As Object, Fichier As Object
Dim ligne As Integer, n As Integer
Dim Plage As Range, Cell As Range
Dim C, C1 As Range
Dim Name As String

Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
    For Each SousDossier In Dossier.SubFolders
        ListeFichier (Chemin & SousDossier.Name & "\")

    For Each Fichier In SousDossier.files
      
        Cells(i, 1) = SousDossier.Name
        Cells(i, 1) = LCase(Cells(i, 1))
        Cells(i, 1) = Replace(Cells(i, 1), " ", "")
            
         If Fichier.Name <> "SUIVI echange P736 avant " & Cells(i, 1) & ".xls" Then
          Cells(i, 1).Delete
          i = i - 1
          Else
            Cells(i, 6) = Fichier.Name
            Cells(i, 3) = Chemin & SousDossier.Name & "\"
            Cells(i, 11) = Chemin & SousDossier.Name & "\" & Fichier.Name
            Cells(i, 15) = "[" & Fichier.Name & "]"
                End If
                i = i + 1
            
    Next
    
    Next

End Function



Puis, ans un autre module je lance les sub et fonction pour ouvrir en fermé les fichier un à un et récupérer la ligne qi contient à la fois mes critères de recherches (pour l'instant je n'en ais fais qu'un) voici le code :
Sub RequeteClasseurFerme()
    Dim Cn As ADODB.Connection
    Dim Fichier As String
    Dim NomFeuille As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
    
    
    
p = 11
Ligne1 = ThisWorkbook.Sheets("Feuil1").Range("K" & "65536").End(xlUp).Row
Set Plage1 = ThisWorkbook.Sheets("Feuil1").Range("K" & "1:" & "K" & Ligne1)
With Plage1

For Each C1 In Plage1

    'Définit le classeur fermé servant de base de données
    Fichier = ThisWorkbook.Sheets("Feuil1").Cells(p, "K")

    

    'Nom de la feuille dans le classeur fermé
    NomFeuille = "SUIVI NC"
    
    Set Cn = New ADODB.Connection
    
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & Fichier & ";Extended Properties=Excel 8.0;"
        .Open
    End With
    '-----------------
    
    'Définit la requête.
    '/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
    texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
    
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
    
    'Ecrit le résultat de la requête dans la cellule A2
    Range("A2").CopyFromRecordset Rst
    
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
Next
p = 11 + 1
End With
End Sub


là il marche mais me prends uniquement le premier fichier qu'il rencontre et s'arrête.
là je suis d'accord il me prends tout le fichier car lorsque je veux faire un select genre :

texte_SQL = "SELECT * FROM [" & NomFeuille & "$]" WHERE * = [" & CIBLE & "]

où CIBLE est juste un critère de sélection il me mets "erreur de syntaxe clause from !!
j'y comprends plus rien.
Lorsque je modifie l'écriture de la recherche (genre par un rechercheV) là j'ai un bel "impossible de trouver le chemin"

bref ais besoin de vos lumières

merci pour votre aide

@ +

1 réponse

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
11 août 2013 à 16:16
Bonjour,
Sans aller plus loin dans ton code...
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
    For Each Fichier In Dossier.files

        i = i + 1
    Next

ListeFichier (Chemin)

Application.ScreenUpdating = True

End Sub 

Tu veux faire quoi là ??
A+
0