Recherche fichier sur hdd
Salut LeDoc
Pas le choix il nous faudra la dernière version du fichier
A+
Bonjour ledoc,
après presque 3 semaines, une retour à mon premier poste.
#If VBA7 Then
Declare PtrSafe 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
#Else
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
#End If
Sub BSALV()
Dim MyPath, MyPrefix, MyExtension, sFilter
MyPath = Range("B2").Value 'ce dossier + sous-dossiers
MyPrefix = Range("B3").Value '1er caractères
MyExtension = Range("B4").Value 'extension
sFilter = MyPath & IIf(Right(MyPath, 1) <> "\", "\", "") & MyPrefix & "*" & MyExtension '--> joindre les 3 éléments
myfiles = Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & sFilter & """ /b /s").StdOut.ReadAll, vbCrLf) 'array avec tous les files
With Range("E1")
.EntireColumn.ClearContents 'vider toute la colonne
If UBound(myfiles) = -1 Then 'rien trouvé
MsgBox "Désolé !!!", vbCritical, sFilter
Else
MsgBox Join(myfiles, vbLf), vbInformation, sFilter 'messagebox avec tous les fichiers
.Resize(UBound(myfiles) + 1).Value = Application.Transpose(myfiles) 'ecrire ces fichiers dans la colonne E
.EntireColumn.AutoFit 'ajuster le largeur de la colonne
For i = 0 To UBound(myfiles) 'boucle des fichiers
If Len(myfiles(i)) > 0 Then 'au moins 1 charactère
MsgBox "file numéro : " & i + 1 & vbLf & myfiles(i), , UCase("ouvrir") 'messagebox avec ce fichier
ShellExecute 0, vbNullString, myfiles(i), vbNullString, vbNullString, 0 ''ouvre avec la visionneuse photo de Windows
'Application.Wait Now + TimeSerial(0, 0, 3) 'ajouter un petit delai pour l'action précedente
DoEvents
End If
Next
End If
End With
End SubBonjour Bruno , je ne peut pas transférer de fichier de mon boulot
Bonjour BASLV , j'ai testé ton fichier chez moi sous xl2021 et çà fonctionne bien
J'ai désactivé des lignes qui ne me sont pas utiles pour mon fichier du boulot, comme d'afficher le nom du ficher en colonne E et d'afficher une msgbox pour dire que le fichier est trouvé et une pour demander l'ouverture.
Mais merci bien de les avoir mis , çà peut toujours me servir
Au boulot par contre çà ne fonctionne pas (xl2013) çà me surligne en jaune la ligne de code suivante:
myfiles = Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & sFilter & """ /b /s").StdOut.ReadAll, vbCrLf)
Et depuis aujourd'hui , chez moi, excel me dit qu'il a détecté des macros malveillantes et ferme le fichier ????
bonjour,
Et depuis aujourd'hui , chez moi, excel me dit qu'il a détecté des macros malveillantes et ferme le fichier ????
Ce message, je l'ai eu qu'une fois, donc cela me surprend pas, mais après plus jamais, donc je pense que c'est quelque part un scanner ou un firewall ? Je ne connais pas grand chose de cela. Si vous fermez et rouvrez le fichier, c'est pareil ?
myfiles = Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & sFilter & """ /b /s").StdOut.ReadAll, vbCrLf)
le msgbox avec sFilter, cela donnait quoi ? Vos fichiers, sont-ils sur un disque dur ou un reseau ?
Salut Ledoc,
Pour ce qui est du code de BsAlv,
c'est logique à mes yeux, il fait appel à une ligne de commande considéré dangereux pas les antivirus qui fonctionnent bien
C'est la différence quand on est en retraite ou toujours actif dans une société qui fait attention à sa sécurité (surtout aujourd'hui)
si ce truc de sécurité reste, c'est peut-être mieux de commencer un nouveau post et de demander l'aide de spécialistes "Power Query" (pas moi !).
Ca pourrait être que vous devez encore installer quelque chose pour ça dans Excel2013.
Le pb de sécurité n'était que chez moi mais est reparti en relançant plusieurs fois le fichier .
#If VBA7 Then
Declare PtrSafe 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
#Else
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
#End If
Sub BSALV()
Dim MyPath, MyPrefix, MyExtension, sFilter
MyPath = Range("B2").Value 'ce dossier + sous-dossiers
MyPrefix = Range("B3").Value '1er caractères
MyExtension = Range("B4").Value 'extension
sFilter = MyPath & IIf(Right(MyPath, 1) <> "\", "\", "") & MyPrefix & "*" & MyExtension '--> joindre les 3 éléments
myfiles = Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & sFilter & """ /b /s").StdOut.ReadAll, vbCrLf) 'array avec tous les files
' With Range("E1")
'.EntireColumn.ClearContents 'vider toute la colonne
If UBound(myfiles) = -1 Then 'rien trouvé
MsgBox "Désolé !!!", vbCritical, sFilter
Else
' MsgBox Join(myfiles, vbLf), vbInformation, sFilter 'messagebox avec tous les fichiers
' .Resize(UBound(myfiles) + 1).Value = Application.Transpose(myfiles) 'ecrire ces fichiers dans la colonne E
' .EntireColumn.AutoFit 'ajuster le largeur de la colonne
For i = 0 To UBound(myfiles) 'boucle des fichiers
If Len(myfiles(i)) > 0 Then 'au moins 1 charactère
' MsgBox "file numéro : " & i + 1 & vbLf & myfiles(i), , UCase("ouvrir") 'messagebox avec ce fichier
ShellExecute 0, vbNullString, myfiles(i), vbNullString, vbNullString, 0 ''ouvre avec la visionneuse photo de Windows
'Application.Wait Now + TimeSerial(0, 0, 3) 'ajouter un petit delai pour l'action précedente
DoEvents
End If
Next
End If
' End With
End SubVoilà le code que j'ai chez moi(xl2021) est qui fonctionne bien
Code que j'ai recopié à la main au boulot(xl2013)
myfiles = Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & sFilter & """ /b /s").StdOut.ReadAll, vbCrLf) 'array avec tous les files
et c'est cette ligne qui est surlignée en jaune quand je lance la macro
le msgbox avec sFilter, cela donnait quoi ? Vos fichiers, sont-ils sur un disque dur ou un reseau ?Effectivement chez moi le répertoire photo est sur le même disque dur dans le pc alors qu'au boulot le fichier ainsi que le répertoire photo sont sur un disque réseau
accessible via une lettre comme tout autre disque local
Je n'ai pas testé msgbox avec filter au boulot encore
re,
ce lettre, par exemple "M:\" est en réalité l'abbrevation de quelque chose comme ceci "\\server\directory1\directory2" ??
Bonjour.
Je viens de retester le code avec un dossier recherche
C:\nouveau dossier\
j'ai aussi mis le fichier dans ce dossier et toujours la meme erreur
je pense que cette fonction n'est peut etre pas compatible avec xl2013.
Bonjour (edit modo)
ce commande est encore niveau MSDOS !!!
Il y a quelque chose autre, un nom de fichier trop long, charactères interdit, accès interdit, je ne sais pas quoi et difficile de voir d'ici, ...
je commence à être désespérer
Dans ce prompt, vous entrez "help dir" (sans double quotes) et alors c'est parti, utilisez par exemple "D:" pour changer de disque, utilisez "dir" pour voir le contenu de la dictionary actuelle, utilisez "chdir MySubdirectory" to change vers un subdirectory de l'actuelle.
Bon de cette manière vous naviguez vers le subdirectory préfére.
Là vous faitez un simple dir, cela cause des problèmes ???
ou bien, il faut s'adresser aux spécialistes "PowerQuery", espérons qu'ils n'ont pas le même genre de problèmes.
Bonjour à tous
Bonjour BsAlv
Encore MsDos, que je continue de pratiquer tous les jours, mais j'ai trouvé des commandes 'dir' avec des pseudos expressions régulières qui ne donnaient pas le bon résultat.
Je pense que PowerQuery utilise le moteur PowerShell qui lui est performant et assez simple et j'espère arriver un jour à l'utiliser sans être frustré d'avoir des difficultés personnelles avec.
Microsoft voulait remplacer MSDos par PowerShell, puis VBA par des programmes en c#, xaml, puis s'est ravisé et a sorti la galaxie PowerBI, PowerApps, PowerAutomate, Power...
Finalement, certains vieux produits n'ont plus de support mais continuent d'exister.
Parmi les nouveaux produits, nous verrons leur durée de vie...
Pour faire une commande Dir, je ne saurai que conseiller d'utiliser PowerShell (get-ChildItem) que j'ai déjà interfacé en VBA , ou simplement Notepad++
Mais c'est vrai que l'on n'utilise bien un formulaire Excel (avec listbox) pour lister des fichiers ou des commandes GetOpenFileName ou FileDialog pour sélectionner un fichier
Pour la commande "split(CreateObject(", je la trouve trop condensée, je préférerai la décomposer pour arriver à faire une maintenance acceptable
@scraper,
le problème majeur, au début, c'étaient des espaces dans le string du directory & filename, maintenant j'espère que cela est resolu, mais ik y a quelque chose autre que je ne sais pas pointer. Que proposez-vous comme solution ?
Ce n'est qu'un avis et c'est ce que j'ai l'habitude de faire
Je décomposerais cette commande trop grande en plusieurs lignes avec l'objet WScript.Shell
j'écrirai la commande dans un fichier .bat assurant la sortie (en lieu et place) et exit le stdOut.ReadAll exit le split vbCrLf
En effet, Un fichier .bat se teste en dehors de VB. Et ensuite on intègre.
Cela permet d'insérer des Debug.Print pour assurer les tests.
un essai
Re Bslav
Qu'est ce que ton nouveau fichier est sensé faire?
Je l'ai testé en remplaçant les données directory prefix suffix
si çà ne trouve pas de fichier çà affiche bien la msgbox
si çà en trouve 1 dans le dossier ou sous dossier , çà ecrit son chemin dans la colonne D
Puis c'est tout.
re,
oui, c'est ce que la macro fait. Un msgbox en cas qu'elle ne trouve rien ou une liste dans la colonne D. Rien d'autres. Si cela fonctionne chez vous à la maison mais aussi sur le reseau de votre employeur, alors on verra ... .
Vous pouvez commencer à penser ce que vous voulez, si la liste est par exemple 10 fichier, ouvrir quand on double-clicque sur un nom ?
Vous pouvez commencer à penser ce que vous voulez, si la liste est par exemple 10 fichier, ouvrir quand on double-clicque sur un nom ?
Pour apprentissage oui mais au taf , je préfère que le fichier s'ouvre directement une fois trouvé
esperons que demain cela fonctionne, parce que j'en ai marre
bonjour, les instructions :
Des que vous avez utilisez la macro, il y aura 3 fichiers dans le sous-répertoire où se trouve le fichier excel, c'est à dire le fichier excel, un fichier texte (avec les résultats de recherche en cas positive) et un fichier batch MS-DOS
Ce fichier batch, on peut l'ouvrir comme-ça Pour ouvrir le fichier . BAT dans le Bloc-notes, cliquez dessus avec le bouton droit de la souris et choisissez Éditer du menu. Vous trouverez peut-être des éditeurs de texte plus avancés prenant en charge la coloration syntaxique, utiles lors de la modification d'un fichier .
le résultat est quelque chose pareil
dir /b /s c:\users\eigenaar\downloads\oude" "files\Mon" "recherch*png>C:\Users\Eigenaar\Downloads\MyLog_Ledoc.txt
la partie rouge, on ne touche pas, c'est le commando "MSDOS".
la partie bleu et mauve, ces sont les 2 paramètres, mais important, quand il y a un éspace, il faut ajouter un double quote autour. J'éspère que c'est clair le but de ce commando rechercher les fichiers dans c:\users\eigenaar\downloads\oude" "files\ et ses sous-répertoires qui comment avec Mon" "recherche et finissent avec png.
Comme @Scraper décrivait, hors Excel et VBA, maintenant vous pouvez adapter votre recherche dans ce fichier "BAT" et experimenter pourquoi mes solutions précédentes n'étaient pas bonnes. Une fois trouvé, on n'a qu'à changer la macro.
Donc c'est maintenant à vous ... . Pour le reseau, essayer avec M:\ ou avec \\Server\... mais surtout