Lire informations disque dur [Résolu]

Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
- - Dernière réponse : BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
- 8 août 2015 à 08:32
Bonjour,

Avec l'objet "Scripting.FileSystemObject", pour chaque support (disque, clé USB ou Lecteur DVD, je sais retrouver :
si le support existe (obj.driveExist(support)
le type de support (support.driveType)
l'espace disponible (support.freeSpace)
La lettre d'affectation (support.Letter).

J'aimerais extraire en plus,
la capacité totale du support
le nom attribué au support
et éventuellement, les références constructeur du support si disque dur
modèle, attributs, serialnumber, etc...

Est-ce possible ?

Je reconnais mon incapacité à fouiller dans la fenêtre "Explorateur d'objets"
Merci à l'avance. Bab, sous Windows 8.0
Afficher la suite 

Votre réponse

19 réponses

Messages postés
23550
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
9 décembre 2018
Commenter la réponse de jordane45
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
0
Merci
Salut et Merci.

Effectivement, je trouve le modèle de mes disques et clés USB avec leurs caractéristiques.
Mais je n'arrive pas avec WMI à faire le lien avec la LETTRE d'affectation pour Windows.
De même, je ne peut retrouver le nom de volume attribué à chaque support.

Je m'obstine...

Ci-après, mes routines :
' extraction pour toutes lettres de C à Z

Sub Lire1
Dim objFSO, XDrive, XLetter, XName, XTotal, XFreeSpace, XType, XExist
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each XDrive In objFSO.Drives
XFreeSpace = 0: XGO = 0
If objFSO.DriveExists(XDrive) Then
XLetter = XDrive.DriveLetter:
XExist = objFSO.DriveExists(XDrive)
XType = XDrive.DriveType
' Type 1= CléUSB, 2= D.Dur, 4=Lecteur DVD
If XType <> 4 Then
XFreeSpace = XDrive.FreeSpace
XTotal = XDrive.totalSize
End If
End If
' afficher réponses
Next : Set objFSO = Nothing: End Sub



Sub Lire2
Dim objWMIService, objItem, colItems, Cpt, X$, y$, L$, L1$
Dim nom, model, size, NbPart, totCyl, TrakCyl
Dim TotHead, TotSect, SectTrak, TotTrak, BitSect
Cpt = ".": 'i = 3
Set objWMIService = GetObject("winmgmts:\\" & Cpt & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive")

For Each objItem In colItems
nom = objItem.Name
model = objItem.model
size = Int(objItem.size / (1073741824))
NbPart = objItem.Partitions
totCyl = objItem.TotalCylinders
TrakCyl = objItem.TracksPerCylinder
TotHead = objItem.TotalHeads
TotSect = objItem.TotalSectors
BitSect = objItem.BytesPerSector
SectTrak = objItem.SectorsPerTrack
TotTrak = objItem.TotalTracks
' afficher réponses
Next : Set objWMIService = Nothing : End Sub

où on n'a aucunement mention du nom alloué aux disques.

Si tu me trouves une erreur (?), j'accepte la remontrance...
A plus ...
Commenter la réponse de BABUDROME
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
0
Merci
Bonjour,
Je ne te comprends pas.
- les différentes partitions d'un disque dur n'ont pas de numéro physique . Seul le disque dur lui-même en a un. Il est unique et concerne la matière (le disque dur lui-même).
- certains supports (tel est le cas de la plupart des clés USB) n'ont pas de numéro physique.
- un lecteur DVD n'est pas un support. Seul l'est le disque que l'on y insère.
Où veux-tu exactement en arriver ?
Commenter la réponse de ucfoutu
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
0
Merci
Bonsoir,

Je voudrais récupérer en même temps que la Lettre d'affectation, le nom du disque ou de la clé USB tels qu'on leur a attribués et qu'on lit en ouvrant la fenêtre [Ordinateur].
ex: "C", "Windows"
"D", " Partition de C"
"E", "" <== Lecteur DVD
"F" , "Mes Photos"
etc...
Ces noms de Label Volume pouvant être renommer, ce me serait utile de les afficher dans mes listes avec Excel.
Or, J'affiche par Lettre, le Type de support, mais ce nom.
Voilà !
A + Bab
--bab
Commenter la réponse de BABUDROME
Messages postés
5594
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 décembre 2018
0
Merci
Bonjour,

Je ne sais pas si c'est cela que tu veux:
en VBS


dim  aff
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
    ("Select * from Win32_LogicalDisk")
For each objDisk in colDisks
   aff = "Compressed: " & vbTab &  objDisk.Compressed & vbcrlf 
    aff = aff & "Description: " & vbTab &  objDisk.Description & vbcrlf     
    aff = aff & "DeviceID: " & vbTab &  objDisk.DeviceID & vbcrlf   
    aff = aff & "DriveType: " & vbTab &  objDisk.DriveType & vbcrlf   
    aff = aff & "FileSystem: " & vbTab &  objDisk.FileSystem & vbcrlf 
    aff = aff & "FreeSpace: " & vbTab &  objDisk.FreeSpace & vbcrlf   
    aff = aff & "MediaType: " & vbTab &  objDisk.MediaType & vbcrlf  
    aff = aff & "Name: " & vbTab &  objDisk.Name & vbcrlf    
    aff = aff & "QuotasDisabled: " & vbTab &  objDisk.QuotasDisabled & vbcrlf
    aff = aff & "QuotasIncomplete: " & vbTab &  objDisk.QuotasIncomplete & vbcrlf
    aff = aff & "QuotasRebuilding: " & vbTab &  objDisk.QuotasRebuilding & vbcrlf
    aff = aff & "Size: " & vbTab &  objDisk.Size & vbcrlf      
    aff = aff & "SupportsDiskQuotas: " & vbTab & objDisk.SupportsDiskQuotas & vbcrlf      
   aff = aff & "SupportsFileBasedCompression: " & vbTab _
               & objDisk.SupportsFileBasedCompression & vbcrlf   
   aff = aff & "SystemName: " & vbTab &  objDisk.SystemName & vbcrlf  
  aff = aff & "VolumeDirty: " & vbTab &  objDisk.VolumeDirty & vbcrlf       
   aff = aff & "VolumeName: " & vbTab &  objDisk.VolumeName & vbcrlf  
   aff = aff & "VolumeSerialNumber: " & vbTab & objDisk.VolumeSerialNumber      
MsgBox aff, vbInformation
Next


facilement transposable en VBA
BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
-
Salut. désolé de te déranger.
J'ai encore besoin de ton savoir.

Si je lit le contenu des disques, je trouve tous les dossiers et les fichiers.
j'en extrait plein d'infos (espace disponible pour les disques, noms des dossiers et des fichiers, dates de création, de dernier accès, etc...
mais je ne trouve pas la propriété indiquant si les objets sont des fichiers ou dossiers System, cachés on non, tels ($RECYCLER, System Volume Information, swapfile.sys, etc...) que je souhaiterais éliminer de mes listes.

Espérant que cet appel te joigne, malgré mon sujet clos.

@+ Bab
cs_Le Pivert
Messages postés
5594
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 décembre 2018
> BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
-
Voir ceci:

http://vb.developpez.com/faq/vbs?page=Acces-aux-Dossiers-Repertoires#Comment-obtenir-des-informations-sur-un-dossier


Option Explicit
'http://vb.developpez.com/faq/vbs?page=Acces-aux-Dossiers-Repertoires#Comment-obtenir-des-informations-sur-un-dossier
Private Sub CommandButton1_Click()
Dim stRep 'Nom du répertoire à parcourir
Dim oFSO, oFld
Set oFSO = CreateObject("Scripting.FileSystemObject")
stRep = "C:\Users\....\Documents\" 'a adapter
If oFSO.FolderExists(stRep) Then
Set oFld = oFSO.GetFolder(stRep)
  MsgBox "Attributes  :" & oFld.Attributes & vbCrLf & _
         "DateCreated :" & oFld.DateCreated & vbCrLf & _
         "DateLastAccessed :" & oFld.DateLastAccessed & vbCrLf & _
         "DateLastModified :" & oFld.DateLastModified & vbCrLf & _
         "Drive :" & oFld.Drive & vbCrLf & _
         "IsRootFolder :" & oFld.IsRootFolder & vbCrLf & _
         "Name :" & oFld.Name & vbCrLf & _
         "ParentFolder :" & oFld.ParentFolder & vbCrLf & _
         "Path :" & oFld.Path & vbCrLf & _
         "ShortName :" & oFld.ShortName & vbCrLf & _
         "ShortPath :" & oFld.ShortPath & vbCrLf & _
         "Size :" & oFld.Size & vbCrLf & _
         "SubFolders.Count :" & oFld.SubFolders.Count & vbCrLf & _
         "Type :" & oFld.Type
End If
End Sub


@+ Le Pivert
ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
> BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
-
Bonjour,
Lis alors la propriété Attribute de chaque objet trouvé

Tu en as une explication ici :
http://www.devguru.com/technologies/vbscript/14028

EDIT : ce que tu peux d'ailleurs également obtenir par utilisation de la fonction VBA GetAttr
Commenter la réponse de cs_Le Pivert
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
0
Merci
Salut et grand Merci.
C'est exactement ce que je voulais.
c'est testé et j'ai les infos voulues.

Autre question , peut-être devrais-je la poser au forum ?
Je te la donne :

Quand je veux supprimer une feuille d'un classeur EXCEL,
ex:
Sheets(feuil).Activate: Sheets(feuil).Delete 

un message me demande confirmation.
Comment éviter cette demande ?

A + et encore merci. Bab
Commenter la réponse de BABUDROME
Messages postés
5594
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 décembre 2018
BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
-
Bonjour cs_Le Pivert
Un gros Pb. m'a contraint à l'abandon de poste, ce qui explique mon retard à poursuivre nos échanges.
Merci pour ta dernière réponse. Elle m'a permis d'avancer dans ma quête.

Toutefois, j'échoue sur un nouvel écueil :

-> Pourquoi, avec la routine ci-après, j'ai de bons resultats en l'appelant avec l'argument 'C:\' ou 'G:\',
mais j'ai une erreur avec l'argument 'G:\`Dos1\dos2' dans la mesure où ces Dos1 dos2 sont présents dans le disque

G existant ?

Sub AfficheContenuVolume(ChDoss$)
Dim fs, f, f1, fc, sf, i%, x$, Att, Sw As Boolean ' ObjCaché est un boolean validant(ou non)
i = 2 ' l'exploitation des documents cachés
1: Set fs = CreateObject("Scripting.FileSystemObject")
' If Not fs.folderexist(ChDoss) Then Exit Sub ' provoque une erreur
Set f = fs.getFolder(ChDoss): Set sf = f.SubFolders
For Each f1 In sf: Att = f1.Attributes: Sw = Att And 6 And ObjCaché: If Sw Then GoTo Nx1
x = "A" + Trim(i): Range(x).Value = f1.Name: Range(x).Font.Bold = True
If Att And 4 Then Range(x).Font.Color = vbRed Else If Att And 2 Then Range(x).Font.Color = vbBlue
x = "B" + Trim(i): Range(x).Value = Format(f1.DateCreated, "dd/mm/yyyy")
x = "C" + Trim(i): Range(x).Value = Format(f1.DateLastModified, "dd/mm/yyyy")
x = "D" + Trim(i): Range(x).Value = "D": i = i + 1
Nx1: Next: i = i + 1: Set fs = Nothing
Set fs = CreateObject("Scripting.FileSystemObject"): Set fc = f.Files
For Each f1 In fc: Att = f1.Attributes: Sw = Att And 6 And ObjCaché: If Sw Then GoTo Nx2
x = "A" + Trim(i): Range(x).Value = f1.Name: Range(x).Font.Bold = False
If Att And 4 Then Range(x).Font.Color = vbRed Else If Att And 2 Then Range(x).Font.Color = vbBlue
x = "B" + Trim(i): Range(x).Value = Format(f1.DateCreated, "dd/mm/yyyy")
x = "C" + Trim(i): Range(x).Value = Format(f1.DateLastModified, "dd/mm/yyyy"): i = i + 1
Nx2: Next: Set fs = Nothing: End Sub

J'ai beau explorer l'aide accessible par F1 (excel 2007 en français) je ne trouve pas d'explication.
Existe-t-il un autre support où trouver les détails, qui pourrait m'éviter, peut-être, de te déranger ?

En tout cas merci encore et à bientôt. Bab
Commenter la réponse de cs_Le Pivert
Messages postés
5594
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 décembre 2018
0
Merci
Voilà:

Option Explicit
Private Sub CommandButton1_Click()
AfficheContenuVolume ("C:\Users\Daniel\Documents\")
End Sub
Sub AfficheContenuVolume(ChDoss$)
 Dim fs, f, f1, fc, sf, i%, x$, Att, Sw As Boolean ' ObjCaché est un boolean validant(ou non)
Dim ObjCaché
 i = 2 ' l'exploitation des documents cachés
1: Set fs = CreateObject("Scripting.FileSystemObject")
If Dir(ChDoss$, vbDirectory) = vbNullString Then Exit Sub
 Set f = fs.getFolder(ChDoss): Set sf = f.SubFolders
 For Each f1 In sf: Att = f1.Attributes: Sw = Att And 6 And ObjCaché: If Sw Then GoTo Nx1
 x = "A" + Trim(i): Range(x).Value = f1.Name: Range(x).Font.Bold = True
 If Att And 4 Then Range(x).Font.Color = vbRed Else If Att And 2 Then Range(x).Font.Color = vbBlue
 x = "B" + Trim(i): Range(x).Value = Format(f1.DateCreated, "dd/mm/yyyy")
 x = "C" + Trim(i): Range(x).Value = Format(f1.DateLastModified, "dd/mm/yyyy")
 x = "D" + Trim(i): Range(x).Value = "D": i = i + 1
Nx1: Next: i = i + 1: Set fs = Nothing
 Set fs = CreateObject("Scripting.FileSystemObject"): Set fc = f.Files
 For Each f1 In fc: Att = f1.Attributes: Sw = Att And 6 And ObjCaché: If Sw Then GoTo Nx2
 x = "A" + Trim(i): Range(x).Value = f1.Name: Range(x).Font.Bold = False
 If Att And 4 Then Range(x).Font.Color = vbRed Else If Att And 2 Then Range(x).Font.Color = vbBlue
 x = "B" + Trim(i): Range(x).Value = Format(f1.DateCreated, "dd/mm/yyyy")
 x = "C" + Trim(i): Range(x).Value = Format(f1.DateLastModified, "dd/mm/yyyy"): i = i + 1
 Columns("A:C").EntireColumn.AutoFit
Nx2: Next: Set fs = Nothing: End Sub


Commenter la réponse de cs_Le Pivert
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
0
Merci
Merci, je vois qu'il me manquait le dernier \ dans mon argument.

Mais la ligne ajoutée
If Dir(ChDoss$, vbDirectory) = vbNullString Then Exit Sub
qui répond vide et sort de suite de la routine si le chemin est incorrect, est très utile pour signaler d'éventuelles erreurs.

Salut et à+ Bab
Commenter la réponse de BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
0
Merci
salut, c'est encore moi.
Après essai, je n'ai pad de résultat!

Private Sub CommandButton2_Click()
    AfficheContenuVolumeLePivert ("H\:Films\")
    AfficheContenuVolumeLePivert ("C\:Comptes\")
    AfficheContenuVolumeLePivert ("K\:Mes sources VB6\Anniversaires\")
    AfficheContenuVolumeLePivert ("C\:Comptes\")
    AfficheContenuVolumeLePivert ("H\:fotos\charlène\")
    AfficheContenuVolumeLePivert ("I\:opérations sur films\")
    AfficheContenuVolumeLePivert ("D\:jeux\lp sudoku\")
End Sub
Sub AfficheContenuVolumeLePivert(ByRef stRep$)
'Dim stRep 'Nom du répertoire à parcourir
    Dim oFSO, oFld
    Set oFSO = CreateObject("Scripting.FileSystemObject")
  '  stRep = "H\:fotos\charlène\" 'a adapter
  Debug.Print stRep, oFSO.FolderExists(stRep)  ' indique Faux pour tous les appels
    If Not oFSO.FolderExists(stRep) Then Exit Sub
    Set oFld = oFSO.GetFolder(stRep)
    MsgBox "Attributes  :" & oFld.Attributes & vbCrLf & _
         "DateCreated :" & oFld.DateCreated & vbCrLf & _
         "DateLastAccessed :" & oFld.DateLastAccessed & vbCrLf & _
         "DateLastModified :" & oFld.DateLastModified & vbCrLf & _
         "Drive :" & oFld.Drive & vbCrLf & _
         "IsRootFolder :" & oFld.IsRootFolder & vbCrLf & _
         "Name :" & oFld.Name & vbCrLf & _
         "ParentFolder :" & oFld.ParentFolder & vbCrLf & _
         "Path :" & oFld.Path & vbCrLf & _
         "ShortName :" & oFld.ShortName & vbCrLf & _
         "ShortPath :" & oFld.ShortPath & vbCrLf & _
         "Size :" & oFld.size & vbCrLf & _
         "SubFolders.Count :" & oFld.SubFolders.Count & vbCrLf & _
         "Type :" & oFld.Type
      '  End If
End Sub


Je pense avoir bien recopier ton code.
Ai-je insérer une erreur ?

A toi. Bab



Commenter la réponse de BABUDROME
Messages postés
5594
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 décembre 2018
0
Merci
C'est cette ligne qui renvoie une erreur:

 "Size :" & oFld.size 


Donc voici le code:

Sub AfficheContenuVolumeLePivert(ByRef stRep$)
'Dim stRep 'Nom du répertoire à parcourir
    Dim oFSO, oFld
    Set oFSO = CreateObject("Scripting.FileSystemObject")
 '  stRep = "H\:fotos\charlène\" 'a adapter
    Debug.Print stRep, oFSO.FolderExists(stRep)  ' indique Faux pour tous les appels
    If Not oFSO.FolderExists(stRep) Then Exit Sub
    Set oFld = oFSO.GetFolder(stRep)
    MsgBox "Attributes  :" & oFld.Attributes & vbCrLf & _
         "DateCreated :" & oFld.DateCreated & vbCrLf & _
         "DateLastAccessed :" & oFld.DateLastAccessed & vbCrLf & _
         "DateLastModified :" & oFld.DateLastModified & vbCrLf & _
         "Drive :" & oFld.Drive & vbCrLf & _
         "IsRootFolder :" & oFld.IsRootFolder & vbCrLf & _
         "Name :" & oFld.Name & vbCrLf & _
         "ParentFolder :" & oFld.ParentFolder & vbCrLf & _
         "Path :" & oFld.Path & vbCrLf & _
         "ShortName :" & oFld.ShortName & vbCrLf & _
         "ShortPath :" & oFld.ShortPath & vbCrLf & _
         "SubFolders.Count :" & oFld.SubFolders.Count & vbCrLf & _
         "Type :" & oFld.Type
End Sub

Commenter la réponse de cs_Le Pivert
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
0
Merci
reSalut

En fait, après retrait de la ligne citée, rien de nouveau.

J(ai supprimer le test oFSO.FolderExists(stRep) pour passer outre.
J'ai insérer un goto error et cela me désigne le stRep comme erroné ? Je ne comprend pas pourquoi, les noms fournis étant corrects.

Private Sub CommandButton2_Click()
AfficheContenuVolumeLePivert ("H\:Films\")
AfficheContenuVolumeLePivert ("C\:Comptes\")
AfficheContenuVolumeLePivert ("K\:Mes sources VB6\Anniversaires\")
AfficheContenuVolumeLePivert ("C\:Comptes\")
AfficheContenuVolumeLePivert ("H\:fotos\charlène\")
AfficheContenuVolumeLePivert ("I\:opérations sur films\")
AfficheContenuVolumeLePivert ("D\:jeux\lp sudoku\")
End Sub
Sub AfficheContenuVolumeLePivert(ByRef stRep$)
Dim oFSO, oFld
On Error GoTo ER
Set oFSO = CreateObject("Scripting.FileSystemObject")
Debug.Print stRep, oFSO.FolderExists(stRep) ' indique Faux pour tous les appels
' If Not oFSO.FolderExists(stRep) Then Exit Sub
Set oFld = oFSO.GetFolder(stRep) ' indique err=76, Chemin d'accès introuvable
MsgBox "Attributes :" & oFld.Attributes & vbCrLf & _
"DateCreated :" & oFld.DateCreated & vbCrLf & _
"DateLastAccessed :" & oFld.DateLastAccessed & vbCrLf & _
"DateLastModified :" & oFld.DateLastModified & vbCrLf & _
"Drive :" & oFld.Drive & vbCrLf & _
"IsRootFolder :" & oFld.IsRootFolder & vbCrLf & _
"Name :" & oFld.Name & vbCrLf & _
"ParentFolder :" & oFld.ParentFolder & vbCrLf & _
"Path :" & oFld.Path & vbCrLf & _
"ShortName :" & oFld.ShortName & vbCrLf & _
"ShortPath :" & oFld.ShortPath & vbCrLf & _
"SubFolders.Count :" & oFld.SubFolders.Count & vbCrLf & _
"Type :" & oFld.Type
GoTo 9
ER: Debug.Print Err, Error: Resume 9
9: On Error GoTo 0
End Sub


A toi. Bab
Commenter la réponse de BABUDROME
Messages postés
5594
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 décembre 2018
0
Merci
A mon avis tes chemins sont faux:

 AfficheContenuVolumeLePivert ("H\:Films\")
    AfficheContenuVolumeLePivert ("C\:Comptes\")
    AfficheContenuVolumeLePivert ("K\:Mes sources VB6\Anniversaires\")
    AfficheContenuVolumeLePivert ("C\:Comptes\")
    AfficheContenuVolumeLePivert ("H\:fotos\charlène\")
    AfficheContenuVolumeLePivert ("I\:opérations sur films\")
    AfficheContenuVolumeLePivert ("D\:jeux\lp sudoku\")


Il manque certainement "C:\Users\nom propriétaire\Comptes\")

Vérifie tes chemins!
BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
-
Mes chemins me paraissent corrects.
exemples avec image de chemins copiés (.PNG), mais je sais comment te les envoyer.

A+ Bab
Commenter la réponse de cs_Le Pivert
Messages postés
5594
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 décembre 2018
0
Merci
si tu veux connaître le chemin d'un fichier utilise ceci:

Dim Fichier As Variant
    'Affichage de la la boîte de dialogue standard "Ouvrir" pour sélectionner un fichier
    'sur le disque dur.
    'GetOpenFilename permet de lire le nom du fichier sélectionné par l'utilisateur sans
    'réellement ouvrir le fichier.
Fichier = Application.GetOpenFilename("Fichiers (*.*),*.*")
    [A1] = Fichier 'inscrire le chemin du fichier sur la feuille 1
     'Vérifie si l'utilisateur a cliqué sur le bouton "Annuler" ou sur la croix de fermeture.
    If Fichier = False Then
        MsgBox "Opération Annulée"
        'pour sortir de la procédure
        Exit Sub
    End If


Si tu veux poster une image, en haut du post à droite, il y a une image avec un paysage de montagne, tu cliques dessus.
Commenter la réponse de cs_Le Pivert
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
0
Merci
Après application de ton code, en voici les résultats :

H:\Films\Taxi\Taxi 4 (FR).avi
C:\Comptes\Comptes.ini
K:\Mes sources VB6\Anniversaires\Sources\AnniTest.txt
C:\Comptes\Led3.bmp
H:\fotos\charlène\152.jpg
I:\Opération sur films\UTILISATION MOVIE MAKER.docx
D:\Jeux\LP Sudoku\LP SUDOKU (Aide).Docx

Cela me semble conforme à mes appels :

AfficheContenuVolumeLePivert ("H\:Films\")
AfficheContenuVolumeLePivert ("C\:Comptes\")
AfficheContenuVolumeLePivert ("K\:Mes sources VB6\Anniversaires\")
AfficheContenuVolumeLePivert ("C\:Comptes\")
AfficheContenuVolumeLePivert ("H\:fotos\charlène\")
AfficheContenuVolumeLePivert ("I\:opérations sur films\")
AfficheContenuVolumeLePivert ("D\:jeux\lp sudoku\")

Qu'en déduire ?

ci-joint, l'image de qq chemins :


A toi, Bab
Commenter la réponse de BABUDROME
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
0
Merci
Bonjour,
Euh ...
inversion de :\ avec \:
non ?
BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
-
Merci à toi, pour avoir l'oeil.
Mon Pb. se trouve résolu.
Grossière erreur, mais p
Commenter la réponse de ucfoutu
Messages postés
5594
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 décembre 2018
0
Merci
Tout a fait ucfoutu.

Bab,

Avec mon code, pourquoi, n'avoir pas fait un copier coller de la cellule A1 pour être sur d'avoir le chemin exact?
Ceux sont des petites erreurs qui te font perdre un temps précieux (d'accord tu es a la retraite LOL)
Commenter la réponse de cs_Le Pivert
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
0
Merci
Ouf! ucfoutu à l'oeil avisé. Ca fonctionne.
Merci à tous les deux... et mes excuses pour la perte de temps que je vous ai fait prendre.
Vraiment désolé !

Faut mettre ça sue le compte d'Alzeimer qui guette les retraités...

A + Bab
BangouraMoussa
Messages postés
2
Date d'inscription
samedi 1 août 2015
Dernière intervention
21 août 2015
-
salue je suis très heureux de voir cet logisciel en detail.
meecie
Commenter la réponse de BABUDROME
Messages postés
151
Date d'inscription
lundi 16 janvier 2006
Dernière intervention
19 avril 2016
0
Merci
Salut, ce classeur est encore en mise au point.

Dès achèvement, je te ferai parvenir sa première version.
Mais, comment t'adresser un fichier ?

A+ Bab
Commenter la réponse de BABUDROME

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.