[Catégorie modifiée VB6 -- VBA] Recherche fichier via BoutonRésolu

Question

Bonjour, 


J'ai une macro qui va chercher des fichiers via un bouton, mais cette macro recherche tous les fichiers d'un dossier complet et les ouvre un par un.
Je voudrais modifier le code pour qu'elle me permette de selectionner le fichier que je veux (je n'arrive pas à trouver la commande je débute en VBA).

Voici le code:

Set Recherche = ClFileSearch.Nouvelle_Recherche
'Set fichcherche = Application.FileSearch

With Recherche


.FolderPath = UserForm4.Rep 'Changer le chemin
.SubFolders = UserForm4.CheckBox1.Value
.Extension = "*.xls"

If .Execute > 0 Then
MsgBox .FoundFilesCount & " Fichier(s) a (ont) été trouvé(s)."
Application.ScreenUpdating = False


Merci beaucoup d'avance
Configuration: Windows XP / Internet Explorer 7.0

Adn56 · Accepted Answer

le code de Le Pivert t'explique justement comment ouvrir une fenétre pour allez chercher ton fichier !
Et puis si ton fichier est généré mensuelement, récupére le nom attribué par le code pour l'ouvrir !
ou alors tu n'a accés qu'a une petite parti de la macro ?
++

cs_Jack · Answer

Salut
Point important : Que représente ClFileSearch ?
Une classe ?
Qu'y a t-il dedans ?

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

Applemilk · Answer

Salut,

Oui, c'est la version de ClasseFilesearch sur 2007. Dedans il ya les conditions de recherches (si j'ai bien compris ta question):
Ca commence comme ça:
'Enumération pour les options de tri
Public Enum Sort_By
    Sort_None
    sort_Name
    sort_Path
    sort_Size
    sort_DateCreated
    sort_LastModified
    sort_Type
End Enum

Dim TabFiles() As InfosResultFichiers
Dim DirectoryPath As String
Dim lngFoundFilesCount As Long
Dim boolSousRep As Boolean
Dim strExtens As String
Dim optionSortBy As Long

'Propriété pour le répertoire de recherche
Public Property Let FolderPath(strFolderPath As String)
    DirectoryPath = strFolderPath
End Property

'Propriété pour rechercher dans les sous dossiers
Public Property Let SubFolders(boolSubFolders As Boolean)
    boolSousRep = boolSubFolders
End Property

'Propriété pour lister les fichiers correspondants à la requête
Public Property Get Files(Idx As Long) As InfosResultFichiers
    Files = TabFiles(Idx)
End Property

Et continue sur beaucoup de lignes.

Le code depuis le début est celui-ci (j'avais oublié le début):

Private Sub CommandButton2_Click()
UserForm4.Hide
Dim i As Long
Dim Recherche As ClFileSearch.ClasseFileSearch
 
 Z = Feuil4.Cells(5, 8)
Set Recherche = ClFileSearch.Nouvelle_Recherche
'Set fichcherche = Application.FileSearch

With Recherche

.FolderPath = UserForm4.Rep 'Changer le chemin
.SubFolders = UserForm4.CheckBox1.Value
.Extension = "*.xls"

If .Execute > 0 Then
MsgBox .FoundFilesCount & " Fichier(s) a (ont) été trouvé(s)."
Application.ScreenUpdating = False


'lignevide
For xx = 25 To 65000
If Feuil4.Cells(xx, 3) = "" Then
Index22 = xx - 1
Exit For
End If
Next xx

Applemilk · Answer

J'ai essayé ca:

With Recherche

.FolderPath = UserForm4.Rep 'Changer le chemin
.SubFolders = UserForm4.CheckBox1.Value
SortBy = sort_Name("BASE PERSO LOCAL 0610")
.Extension = "*.xls"

Mais ca met un message d'erreur de compilation "tableau attendu".

Je ne comprends pas l'erreur...

cs_Jack · Answer

Normal, ta ligne ne veut rien dire.
SortBy et sort_Name sont des constantes définissant les type de tri, semble t-il. Ce sont ces noms que tu retrouveras en paramètre dans une fonction de l'objet/classe.

Si c'est un produit Microsoft, il doit y avoir des explications et des exemples dans l'aide.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

Applemilk · Answer

Oui effectivement, il faut juste mettre :
SortBy = sort_Name
apparement

Mais ce n'est pas ce que je cherchais de toute façon.

Je ne sais pas si ca existe, est ce qu'on peut faire en sorte que la macro fasse l'extraction d'un fichier précis plutôt que d'un dossier complet?

J'ai cherché dans l'aide de VB et sur pleins de forums et Tuto mais en vain...
Je cherche peut etre quelque chose qui n'existe pas!?

Merci

cs_Jack · Answer

J'ai ouvert Excel 2007 mais aucune trace de classe toute faite.
D'où provient-elle ?
Le plus approprié serait de demander à son créateur ...
Si on ne la connait pas, impossible de te dire ce dont elle est capable ...
Explique comment elle est arrivée dans ton projet.

Adn56 · Answer

salut, je ne comprend pas le soucis ?
Si tu cherche à extraire un fichier précis, pourquoi ne pas l'ouvrir avec son nom ? ("BASE PERSO LOCAL 0610") 
Je suppose bien sûr qu'il n'y a pas d'openfile dialogbox en vba ? non ? sinon tu a la solution.
++

cs_Le Pivert · Answer

Bonjour,
Essayez cela 
'Ouvrir fichiers dans leur programme par défaut
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim fichier As String
'ouvrir tous les fichier sauf xls
Sub ouvriravec()
On Error Resume Next
fichier = Application.GetOpenFilename("All Files (*.*), *.*")
If fichier = "" Then
Exit Sub
Else
Dim Ret As Variant
Ret = ShellExecute(hwnd, "open", fichier, "", vbNullString, 1) 'Var= chemin du fichier
End If

End Sub
'Ouvrir fichiers xls
Sub OuvrirFichier()
On Error Resume Next
fichier = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If fichier = "" Then
Exit Sub
Else
Workbooks.Open Filename:=fichier  'ouvre fichiers xls dans la feuille Excel
End If
End Sub
Private Sub CommandButton1_Click()
ouvriravec 'ouvrir tous les fichier sauf xls
End Sub
Private Sub CommandButton2_Click()
OuvrirFichier 'Ouvrir fichiers xls
End Sub

@+
Le Pivert

Applemilk · Answer

Pour répondre à la question d'Adn56, je veux utiliser un Userform pour aller chercher mon fichier parce qu'il change tous les mois et change d'emplacement. Enfin je dis ca... peut être que l'd'openfile dialogbox peut le faire... je continue à chercher Jack > J'ai apparement une classe toute faite. Quand j'ouvre excel et VB, j'ai une ligne classFilsearch.xla en haut à gauche dans l'exporateur de projets. avec un code préfait... qui a l'air de venir de ce site: 'http://silkyroad.developpez.com/ , je n'avais pas vu... "Option Explicit Option Compare Text Option Base 1 '------------------------------------------------- 'Module de classe ClasseFileSearch pour Excel 2007 'SilkyRoad 'http://silkyroad.developpez.com/ ' ' 'Mise à jour le 01.07.2007 '------------------------------------------------- 'La procédure recherche des fichiers en fonction des critères 'spécifiés et renvoie dans un tableau : 'Le nom des fichiers 'Le chemin 'La taille des fichers (en octets) 'La date de création 'La date de dernière modification 'Le type de fichier) '------------------------------------------------- 'Enumération pour les options de tri Public Enum Sort_By Sort_None sort_Name sort_Path sort_Size sort_DateCreated sort_LastModified sort_Type End Enum Dim TabFiles() As InfosResultFichiers Dim DirectoryPath As String Dim lngFoundFilesCount As Long Dim boolSousRep As Boolean Dim strExtens As String Dim optionSortBy As Long 'Propriété pour le répertoire de recherche Public Property Let FolderPath(strFolderPath As String) DirectoryPath = strFolderPath End Property 'Propriété pour rechercher dans les sous dossiers Public Property Let SubFolders(boolSubFolders As Boolean) boolSousRep = boolSubFolders End Property 'Propriété pour lister les fichiers correspondants à la requête Public Property Get Files(Idx As Long) As InfosResultFichiers Files = TabFiles(Idx) End Property 'Propriété pour l'extension des fichiers à rechercher Public Property Let Extension(strExtension As String) strExtens = strExtension End Property 'Propriété pour compte le nombre de fichiers Public Property Get FoundFilesCount() As Long FoundFilesCount = lngFoundFilesCount End Property 'Propriété pour l'option de tri Public Property Let SortBy(lngSortBy As Sort_By) optionSortBy = lngSortBy End Property 'Fonction d'exécution Public Function Execute() As Long 'Lance la recherche ListeFichiers DirectoryPath 'Vérifie que des fichiers ont été trouvés et qu'une option de tri a 'été spécifié avant de lancer la procédure de tri. If lngFoundFilesCount > 1 And optionSortBy <> Sort_By.Sort_None Then _ FonctionTri optionSortBy Execute = lngFoundFilesCount End Function 'Procédure pour lister les fichiers Private Sub ListeFichiers(strFolderName As String) Dim Fso As Object Dim NomDossier As Object, SousDossier As Object Dim objFichier As Object On Error GoTo Fin 'Vérifie si le dossier spécifié existe If Dir(strFolderName, vbDirectory Or vbHidden Or vbSystem) = "" Then Exit Sub Set Fso = CreateObject("Scripting.FileSystemObject") Set NomDossier = Fso.GetFolder(strFolderName) 'Boucle sur les fichiers du répertoire For Each objFichier In NomDossier.Files 'Vérifie l'extension du fichier If objFichier.Name Like strExtens Or strExtens = "" Then 'Redimensionne le tableau pour ajouter un nouvel élément lngFoundFilesCount = lngFoundFilesCount + 1 ReDim Preserve TabFiles(lngFoundFilesCount) 'Nom fichier TabFiles(lngFoundFilesCount).strFileName = objFichier.Name 'Répertoire TabFiles(lngFoundFilesCount).strPathName = objFichier.ParentFolder 'Taille du fichier (en octets) TabFiles(lngFoundFilesCount).lngSize = objFichier.Size 'Date de création TabFiles(lngFoundFilesCount).DateCreated = objFichier.DateCreated 'Date de création ou dernière modification TabFiles(lngFoundFilesCount).DateLastModified = objFichier.DateLastModified 'Type de fichier TabFiles(lngFoundFilesCount).strFileType = objFichier.Type End If Next objFichier 'Boucle récursive: '(Si l'option de recherche dans les sous répertoires a été spécifiée) If boolSousRep Then For Each SousDossier In NomDossier.SubFolders ListeFichiers SousDossier.Path Next SousDossier End If Exit Sub: Fin: MsgBox "Erreur '" & Err.Number & "'" & vbCrLf & vbCrLf & _ Err.Description, vbInformation End Sub 'Procédure de tri (reste à améliorer). Private Sub FonctionTri(optionSortBy As Sort_By) Dim i As Long, j As Long, k As Long Dim ValTemp As Variant 'Vérifie quel champ du tableau doit être trié Select Case optionSortBy Case Sort_By.sort_Name For i = LBound(TabFiles) To UBound(TabFiles) j = i For k = j + 1 To UBound(TabFiles) If TabFiles(k).strFileName j Then ValTemp TabFiles(j).strFileName: TabFiles(j).strFileName _ TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp ValTemp TabFiles(j).strPathName: TabFiles(j).strPathName _ TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp ValTemp TabFiles(j).lngSize: TabFiles(j).lngSize _ TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp ValTemp TabFiles(j).DateCreated: TabFiles(j).DateCreated _ TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp ValTemp TabFiles(j).DateLastModified: TabFiles(j).DateLastModified _ TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp ValTemp TabFiles(j).strFileType: TabFiles(j).strFileType _ TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp End If Next i Case Sort_By.sort_Path For i = LBound(TabFiles) To UBound(TabFiles) j = i For k = j + 1 To UBound(TabFiles) If TabFiles(k).strPathName j Then ValTemp TabFiles(j).strFileName: TabFiles(j).strFileName _ TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp ValTemp TabFiles(j).strPathName: TabFiles(j).strPathName _ TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp ValTemp TabFiles(j).lngSize: TabFiles(j).lngSize _ TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp ValTemp TabFiles(j).DateCreated: TabFiles(j).DateCreated _ TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp ValTemp TabFiles(j).DateLastModified: TabFiles(j).DateLastModified _ TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp ValTemp TabFiles(j).strFileType: TabFiles(j).strFileType _ TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp End If Next i Case Sort_By.sort_Size For i = LBound(TabFiles) To UBound(TabFiles) j = i For k = j + 1 To UBound(TabFiles) If TabFiles(k).lngSize j Then ValTemp TabFiles(j).strFileName: TabFiles(j).strFileName _ TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp ValTemp TabFiles(j).strPathName: TabFiles(j).strPathName _ TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp ValTemp TabFiles(j).lngSize: TabFiles(j).lngSize _ TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp ValTemp TabFiles(j).DateCreated: TabFiles(j).DateCreated _ TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp ValTemp TabFiles(j).DateLastModified: TabFiles(j).DateLastModified _ TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp ValTemp TabFiles(j).strFileType: TabFiles(j).strFileType _ TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp End If Next i Case Sort_By.sort_DateCreated For i = LBound(TabFiles) To UBound(TabFiles) j = i For k = j + 1 To UBound(TabFiles) If TabFiles(k).DateCreated j Then ValTemp TabFiles(j).strFileName: TabFiles(j).strFileName _ TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp ValTemp TabFiles(j).strPathName: TabFiles(j).strPathName _ TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp ValTemp TabFiles(j).lngSize: TabFiles(j).lngSize _ TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp ValTemp TabFiles(j).DateCreated: TabFiles(j).DateCreated _ TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp ValTemp TabFiles(j).DateLastModified: TabFiles(j).DateLastModified _ TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp ValTemp TabFiles(j).strFileType: TabFiles(j).strFileType _ TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp End If Next i Case Sort_By.sort_LastModified For i = LBound(TabFiles) To UBound(TabFiles) j = i For k = j + 1 To UBound(TabFiles) If TabFiles(k).DateLastModified j Then ValTemp TabFiles(j).strFileName: TabFiles(j).strFileName _ TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp ValTemp TabFiles(j).strPathName: TabFiles(j).strPathName _ TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp ValTemp TabFiles(j).lngSize: TabFiles(j).lngSize _ TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp ValTemp TabFiles(j).DateCreated: TabFiles(j).DateCreated _ TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp ValTemp TabFiles(j).DateLastModified: TabFiles(j).DateLastModified _ TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp ValTemp TabFiles(j).strFileType: TabFiles(j).strFileType _ TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp End If Next i Case Sort_By.sort_Type For i = LBound(TabFiles) To UBound(TabFiles) j = i For k = j + 1 To UBound(TabFiles) If TabFiles(k).strFileType j Then ValTemp TabFiles(j).strFileName: TabFiles(j).strFileName _ TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp ValTemp TabFiles(j).strPathName: TabFiles(j).strPathName _ TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp ValTemp TabFiles(j).lngSize: TabFiles(j).lngSize _ TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp ValTemp TabFiles(j).DateCreated: TabFiles(j).DateCreated _ TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp ValTemp TabFiles(j).DateLastModified: TabFiles(j).DateLastModified _ TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp ValTemp TabFiles(j).strFileType: TabFiles(j).strFileType _ TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp End If Next i End Select End Sub"

Applemilk · Answer

Merci,

J'ai essayé son code, il fonctionne mais ce n'est pas tout à fait ce que je recherche.
En fait Jack avait raison depuis le début, ca dépend de ce qu'il y a dans la classe clfilesearch.

C'est celui là qu'il faut que je modifie, ce n'est qu'un modèle récupéré sur internet.

Je vais essayer de l'adapter, maintenant que je sais d'où ça vient.

Merci encore pour votre aide!

[Catégorie modifiée VB6 --> VBA] Recherche fichier via Bouton

11 réponses

Votre réponse

Discussions similaires