Macro VB-Excel pour rechercher un fichier et obtenir chemin d'accès

BIG95 Messages postés 4 Date d'inscription mardi 2 mars 2010 Statut Membre Dernière intervention 18 mars 2010 - 2 mars 2010 à 16:41
alexandrevandenberghe Messages postés 149 Date d'inscription lundi 24 décembre 2007 Statut Membre Dernière intervention 16 juillet 2013 - 18 mars 2010 à 14:24
Bonjour,

Je voudrais réaliser une macro afin de remplir un tableau récapitulatif (ici pour de la facturation).
Je vous expose le problème, chacune des factures est identifiée par un numéro, par exemple 2010.03.02 si la facture avait été réalisée aujourd'hui, mais chacune d'elle est dans un dossier particulier.

Ne connaissant pas le nombre et les numéros des factures par coeur, je voudrais rechercher dans un dossier une facture (commençons par 2010.01.01), puis obtenir son chemin d'accès afin de remplir mon tableau en indiquant les cases correspondantes (les cases en questions sont toujours les mêmes dans chacune des factures).

Les factures sont au format excel, et je dispose d'excel 2007.

Si je n'ai pas été clair n'hésitez pas à me le faire remarquer.

Merci d'avance.

7 réponses

c148270 Messages postés 303 Date d'inscription mercredi 12 janvier 2005 Statut Membre Dernière intervention 3 octobre 2013 1
3 mars 2010 à 09:25
Bonjour

Voici un exemple parmi d'autres méthodes

Private Const MAX_PATH = 260
Private Const BIF_BROWSEINCLUDEFILES = &H4000
Private Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Function OpenDirectoryTV()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BROWSEINFO
szTitle = odtvTitle
With tBrowseInfo
.hwndOwner = 0
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_BROWSEINCLUDEFILES
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
OpenDirectoryTV = sBuffer
End If
End Function

bonne journée
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 234
3 mars 2010 à 09:32
Bonjour,
je lis :
je voudrais rechercher dans un dossier une facture

On connait donc le dossier où chercher .
Dans un tel cas de figure : ===>>> Simple utilisation de la fonction Dir (à lire dans l'aide en ligne), laquelle admet l'utilisation de "jokers" (caractères génériques)0 En alimentant une listbox par les résultats retenus, il suffit ensuite de cliquer sur l'article de son choix dans la listbox !
Nombreux exemples sur ce forum !

____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée" en bas d'une solution adéquate est
0
BIG95 Messages postés 4 Date d'inscription mardi 2 mars 2010 Statut Membre Dernière intervention 18 mars 2010
4 mars 2010 à 18:14
Merci pour vos réponses rapides.

En effet on connait le dossier à chercher, c'est celui où ce trouve la feuille récapitulative. Il faudrait aller chercher dans les sous-dossier de ce dossier.

Mais ce serait plûtot une recherche automatique. J'ai fait un tableau avec les différents mois et les factures possible (par exemple pour Janvier : 2010.01.01; 2010.01.02; etc.).

La première étape serait de vérifier la présence dans les sous-dossiers du fichier 2010.01.01.xls,s'il existe, de copier (ou plutôt d'indiquer le chemin du fichier et les cellules correspondantes) les cellules qui m'intéressent dans le tableau, puis de passer au fichier suivant 2010.01.02.xls, et ainsi de suite...

Je ne sais pas si je suis très clair.

Merci d'avance.
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 234
4 mars 2010 à 18:38
Bon...
si tu connais le nom du fichier à rechercher dans un répertoire connu et ses sous-répertoires, voilà comment :
Private Declare Function SearchTreeForFile Lib "imagehlp" (ByVal RootPath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long
Private Const MAX_PATH = 260

Private Sub Commandbutton1_Click()
 Dim repertoire As String, fichier As String
 repertoire = "e:\aaaaa"
 fichier = "essai1.txt" ' <<<<<======== ici le nom de TON fichier à rechercher
 MsgBox trouve(repertoire, fichier)
End Sub

Private Function trouve(R As String, F As String) As String
  Dim T As String, resu As Long
  T = String(MAX_PATH, 0)
  resu = SearchTreeForFile(R, F, T)
  If resu <> 0 Then
    trouve = Left$(T, InStr(1, T, Chr$(0)) - 1): Exit Function
  End If
End Function


Il ne te reste plus qu'à faire une boucle sur tous tes noms de fichiers, à rechercher un par un.
A toi de les ouvrir ensuite (c'est une autre question) comme tu entends le faire


____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée" en bas d'une solution adéquate est
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
BIG95 Messages postés 4 Date d'inscription mardi 2 mars 2010 Statut Membre Dernière intervention 18 mars 2010
11 mars 2010 à 14:28
Bonjour,

Merci pour cette réponse elle m'a bien fait avancé.

J'obtiens à présent un chemin d'accès pour un fichier de la forme :

C:\...\...\nomdufichier.xls

Or la formule pour avoir accès une des cellules qui m'intéressent est de la forme :

='C:\...\...\[nomdufichier.xls]nomdelafeuille'!$F$21

Pour ce faire je pensais enlever nomdufichier.xls, puis récupérer C:\...\...\ , et le recomposer avec [nomdufichier.xls]nomdelafeuille'!$F$21, pour ensuite l'inscrire dans une cellule.

Comment récupérer alors le chemin d'accès sans le nom du fichier?

Merci d'avance.
0
BIG95 Messages postés 4 Date d'inscription mardi 2 mars 2010 Statut Membre Dernière intervention 18 mars 2010
18 mars 2010 à 14:01
Bonjour,

Je vois que le message par aux oubliettes. Je me permets de relancer.

Merci d'avance.
0
alexandrevandenberghe Messages postés 149 Date d'inscription lundi 24 décembre 2007 Statut Membre Dernière intervention 16 juillet 2013 6
18 mars 2010 à 14:24
bonjour, ceci devrai vous aider, il faudra reecrire le code...

Dim ligne As Long
Sub test()
Dim Nb&, taille As Double

ligne = 1

NbDeFichiers "E:\Perso\Visual Studio 2008\WebSites\MesLivres", Nb&, taille, True

Cells(1, 1) = "Nom du répertoire"
Cells(1, 2) = "Nom du fichier"
Cells(1, 3) = "Taille du fichier"

Cells(ligne + 1, 2) = "Total (en octets)"
Cells(ligne + 1, 3) = taille

Cells.EntireColumn.AutoFit

MsgBox "Nombre de fichiers : " & Nb & " " & vbCrLf & "taille du répertoire : " & taille & " octets."
End Sub
Sub NbDeFichiers(LeDossier$, Cpte&, taille As Double, Optional SousDossiers As Boolean = True)
Dim fso As Object, Dossier As Object
Dim sousRep As Object

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

If Dossier.Name <> Replace(Dossier.Name, "è", "e") Then
Dossier.Name = Replace(Dossier.Name, "è", "e")
End If

For Each file In Dossier.Files
Cpte = Cpte + 1
taille = taille + file.Size
ligne = ligne + 1

If file.Name <> Replace(file.Name, "è", "e") Then
file.Name = Replace(file.Name, "è", "e")
End If

Cells(ligne, "A") = Dossier.Name
Cells(ligne, "B") = file.Name
Cells(ligne, "C") = file.Size
Next

If SousDossiers Then
For Each sousRep In Dossier.SubFolders
NbDeFichiers sousRep.Path, Cpte, taille
Next sousRep
End If
Set fso = Nothing
End Sub
0