XL 2019 Gestion des fichiers et répertoires

[MarcDJ]

Bonjour à tous,

Où pourrais-je trouver de la documentation pour gérer des fichiers et répertoires en VBA Excel 2019.

L'idée est d'aller sur un disque dur, sélectionner un répertoire avec des noms et en fonction des noms télécharger
les 5 photos correspondant au nom.

Merci d'avance pour réponses

 

[kiki29]

Re, bien penser et vérifier cette remarque de MJ13

Le problème, c'est qu'on ne peut pas créer un multi-dossier avec les codes proposés par MarcDJ.

 

[MarcDJ]

Bonjour kiki29,

Que dois-je changer, dès lors, pour obtenir ce multi dossier ?

Merci pour votre commentaire.

 

[kiki29]

Re, n'étant pas un adepte du "tout cuit", que ce soit moi ou MJ13 on t'a fourni des exemples qui le permette, à toi de les adapter à ton contexte.

 

[MarcDJ]

Re,
Merci kiki29 mais pour le moment je ne comprends pas trop vos Codes et je n'aime pas quand je suis dans le vague Je dois évoluer jusque là.

 

[MarcDJ]

Bonjour à Tous,

J'ai un petit soucis avec l'Affichage de ce Script

Sub CapaciteLecteur()


    ' Afficher la Capacité de chaque Lecteur ainsi que la lettre du Lecteur
  
    Dim GestionFichier As New Scripting.FileSystemObject
        ' On déclare une Variable de Type Objet qui représente un Lecteur
        Dim Lecteur As Object
            ' Pour "For" Chaque "Each" Lecteur dans le PC "Drives"
            For Each Lecteur In GestionFichier.Drives
                ' On affiche la Propriété "TotalSize" Capacité du Lecteur
                MsgBox Lecteur.DriveLetter & " = " & Lecteur.TotalSize
            Next
    Set GestionFichier = Nothing
  
End Sub

Debug.Print ne fonctionne pas et MsgBox m'oblige à chaque fois d'appuyer sur Ok pour me présenter le Lecteur suivant. J'aimerais plutôt que tous les lecteurs s'affichent dans une seule Fenêtre.

Merci d'avance pour vos commentaires.

 

[MJ13]

Re,

Il suffit de définir une variable avant la boucle et l'incrémenter au niveau du msgbox avec un chr(10).

 

[MarcDJ]

Bonjour MJ13,

Je regarde à cela et je reviens vers vous.

Merci

 

[MarcDJ]

Re,

Franchement je n'y arrive pas, soit tout se répète autant de fois que la Boucle For Compteur = 1 to 5.
Avec Do While je n'arrive pas à trouvé la bonne condition et le Chr(10) je l'ai rajouté à la fin de la ligne MsgBox précédé du signe &.
MsgBox Lecteur.DriveLetter & " = " & Lecteur.TotalSize & Chr(10)

Votre aide me serait précieuse si je veux avancer.

 

[kiki29]

Re, qqch du genre :

Option Explicit

Sub CapaciteLecteur()
Dim FSO As Object, sStr As String
Dim Lecteur As Object
    sStr = ""
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each Lecteur In FSO.Drives
        On Error Resume Next
        sStr = sStr & Lecteur.DriveLetter & " = " & Format(Lecteur.TotalSize, "#,##0") & vbCrLf
    Next Lecteur
    Set FSO = Nothing
    MsgBox sStr, vbOKOnly + vbInformation, "Taille Lecteurs :"
End Sub

ou peut être mieux ?

Option Explicit

Sub CapaciteLecteur()
Dim FSO As Object, sStr As String
Dim Lecteur As Object
    sStr = ""
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each Lecteur In FSO.Drives
        On Error Resume Next
        sStr = sStr & Lecteur.DriveLetter & " = " & Unite(Lecteur.TotalSize) & vbCrLf
    Next Lecteur
    Set FSO = Nothing
    MsgBox sStr, vbOKOnly + vbInformation, "Taille Lecteurs :"
End Sub

Private Function Unite(ByVal Taille As Double) As String
Dim TabUnite As Variant
Dim i As Long

    i = 0
    TabUnite = Array("Octets", "Ko", "Mo", "Go", "To")
    Do While Taille >= 1024 And i < 4
        Taille = Taille / 1024
        i = i + 1
    Loop

    Unite = Round(Taille, 2) & " " & TabUnite(i)
End Function

 

[MJ13]

Re

Sinon une petite routine que j'utilise pour scanner mes lecteurs sur une feuille.

Sub recherche_lecteurs_SurFeuille()
'code adapté par MJ issu de http://www.excel-downloads.com/forum/14470-trouver-un-fichier-sur-le-pc.html
Derl = Range("K65536").End(xlUp).Rows.Row
Range("K2:L" & Derl).Select
Selection.ClearContents
Dim Fso As Object
Dim Drv As Object
Dim Msg$
Range("K2").Select
Set Fso = CreateObject("Scripting.FileSystemObject")
Msg = "Votre système a " & Fso.drives.Count & " lecteurs :" & vbLf & vbLf
For Each Drv In Fso.drives
With Drv
'Stop
Select Case .DriveType
Case 0 ' unknown
Msg = Msg & "Lecteur: " & .DriveLetter & " est de type inconnu." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "type inconnu"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 1 ' removable, e.g., zip
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque amovible." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque amovible"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 2 ' fixed, hard drive
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque dur." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque dur"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 3 ' remote
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque réseau." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque réseau"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 4 ' CDROM
Msg = Msg & "Lecteur: " & .DriveLetter & " est un CDROM." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "CDROM"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 5 ' ram disk
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque virtuel." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque virtuel"
 ActiveCell.Offset(1, -1).Range("A1").Select
End Select
End With
Next Drv
Cells(2, 1).Select
'MsgBox Msg, , "Lecteurs du système"
End Sub

Sub Trouve_CléUSB()
Dim Fso As Object
Dim Drv As Object
Dim Msg$
Set Fso = CreateObject("Scripting.FileSystemObject")
'MsgBox ("Votre système a " & FSO.drives.Count & " lecteurs :" & vbLf & vbLf)
For Each Drv In Fso.drives
If Drv.DriveType = 1 Then MsgBox (Drv & " est un Disque amovible")
Next

End Sub

 

[MarcDJ]

Bonjour, MJ13 et kiki29,

Tout d'abord, merci pour vos codes, je reviens vers vous après essai.

Votre façon de coder est totalement différente de celle que je suis censée apprendre.

Je crois que je suis en train de m'enliser dans un codage dépassé VBA Excel 2010, dont certaines instructions ne fonctionnent plus (il me semble). Où pourrais-je trouver un cours (non payant) ou tutoriel pour apprendre la bonne méthode. Apprendre pour apprendre autant débuter avec quelque chose de valable.

Merci d'avance pour votre aide.

 

[kiki29]

Re, commencer par tuto d'algorithmique puis entre autres :
Apprendre la programmation en VBA pour EXCEL par la pratique ( en 6 parties )
https://laurent-ott.developpez.com/tutoriels/programmation-excel-vba-tome-1/
https://laurent-ott.developpez.com/tutoriels/programmation-excel-vba-tome-2/
https://laurent-ott.developpez.com/tutoriels/programmation-excel-vba-tome-3/
https://laurent-ott.developpez.com/tutoriels/programmation-excel-vba-tome-4/
https://laurent-ott.developpez.com/tutoriels/programmation-excel-vba-tome-5/
https://laurent-ott.developpez.com/tutoriels/programmation-excel-vba-tome-6/

 

[MJ13]

Re

Il est vrai que pour comprendre le VBA, il vaut mieux faire une petite formation.

Sinon j'ai trouvé un code issu de Microsoft:

DriveLetter property (Visual Basic for Applications)

Office VBA reference topic

docs.microsoft.com

Sub ShowDriveletter_C_D()
drvPath = ActiveWorkbook.Path
ShowDriveletter (drvPath)
ShowDriveletter ("D:\")
End Sub
Sub ShowDriveletter(drvPath)
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(drvPath))
    s = "Drive " & d.DriveLetter & ": - "
    s = s & d.VolumeName & vbCrLf
    s = s & "Free Space: " & FormatNumber(d.FreeSpace / 1024, 0)
    s = s & " Kbytes"
    MsgBox s
End Sub

 

[MarcDJ]

Re, à vous deux,

Merci pour votre aide et me voilà avec de quoi m'occuper un certain temps, mais je ne m'inquiète pas parce que je sais que je peux compter sur vous en cas de problème.