Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel program files

program files

8 réponses
Avatar
mye
bonjour a tous,
Equipé avec Excel 2000 sous Wimdows XP, je voudrais pouvoir copier la liste
Program files dans du fichier. Ce qui me permettrais de le mettre a jour, de
le classer et dans une autre colonne, son utilisation (pas toujours
evidente, d'apres le nom)
Merci de vos reponses.

--
m&y
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
AV
A adapter :

Sub ListeFichiers() 'd'après J.W
Application.ScreenUpdating = False
dossier = "c:Program FilesMicrosoft Office 2000Office"
Lg = 1
Sheets.Add
Cells(Lg, 1) = "Fichiers dans " & dossier
Cells(Lg, 2) = "Taille"
Cells(Lg, 3) = "Date/Heure"
[A1:C1].Font.Bold = True
Lg = 2
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = dossier
.Filename = "*.*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
x = .FoundFiles(i)
Cells(Lg, 1) = Mid(x, Len(x) - Application.Find("", StrReverse(x))
+ 2, 9 ^ 9)
Cells(Lg, 2) = FileLen(.FoundFiles(i))
Cells(Lg, 3) = FileDateTime(.FoundFiles(i))
Lg = Lg + 1
Next i
End With
[A:C].EntireColumn.AutoFit
End Sub

AV
Avatar
jps
c'est quoi, alain, ce StrReverse qui bogue chez moi....parce qu'XL 97 je
pense...ça peut-y se remplacer?
à suivre et merci d'avance
jps

"AV" a écrit dans le message de
news:OfRUg%
A adapter :

Sub ListeFichiers() 'd'après J.W
Application.ScreenUpdating = False
dossier = "c:Program FilesMicrosoft Office 2000Office"
Lg = 1
Sheets.Add
Cells(Lg, 1) = "Fichiers dans " & dossier
Cells(Lg, 2) = "Taille"
Cells(Lg, 3) = "Date/Heure"
[A1:C1].Font.Bold = True
Lg = 2
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = dossier
.Filename = "*.*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
x = .FoundFiles(i)
Cells(Lg, 1) = Mid(x, Len(x) - Application.Find("",
StrReverse(x))

+ 2, 9 ^ 9)
Cells(Lg, 2) = FileLen(.FoundFiles(i))
Cells(Lg, 3) = FileDateTime(.FoundFiles(i))
Lg = Lg + 1
Next i
End With
[A:C].EntireColumn.AutoFit
End Sub

AV




Avatar
AV
c'est quoi, alain, ce StrReverse qui bogue chez moi....parce qu'XL 97 je
pense...ça peut-y se remplacer?


Exact c'est une nouveauté XL 2000
La même chose pour XL97 et + :

Sub ListeFichiers() 'd'après J.W
Application.ScreenUpdating = False
dossier = "c:Program FilesMicrosoft Office 2000Office"
Lg = 1
Sheets.Add
Cells(Lg, 1) = "Fichiers dans " & dossier
Cells(Lg, 2) = "Taille"
Cells(Lg, 3) = "Date/Heure"
[A1:C1].Font.Bold = True
Lg = 2
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = dossier
.FileName = "*.*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
x = .FoundFiles(i)
y = ARABIC(x)
Cells(Lg, 1) = Mid(x, Len(x) - Application.Find("", y) + 2, 9 ^ 9)
Cells(Lg, 2) = FileLen(.FoundFiles(i))
Cells(Lg, 3) = FileDateTime(.FoundFiles(i))
Lg = Lg + 1
Next i
End With
[A:C].EntireColumn.AutoFit
End Sub

Function ARABIC(zz) 'inverser la chaîne
For C = 0 To Len(zz)
ARABIC = ARABIC & Right(Left(zz, Len(zz) - C), 1)
Next
End Function

AV

Avatar
docm
Bonjour jps.

Pour ceux qui n'ont pas la fonction StrReverse, voici qui peut la remplacer.

Function StrReverse(ByVal Texte As String) As String
Dim longueur As Long, index As Long

longueur = Len(Texte)
StrReverse = Space$(longueur)
For index = 1 To longueur
Mid$(StrReverse, longueur + 1 - index, 1) = Mid$(Texte, index, 1)
Next

End Function

Amicalement.

"jps" wrote in message
news:
c'est quoi, alain, ce StrReverse qui bogue chez moi....parce qu'XL 97 je
pense...ça peut-y se remplacer?
à suivre et merci d'avance
jps

"AV" a écrit dans le message de
news:OfRUg%
A adapter :

Sub ListeFichiers() 'd'après J.W
Application.ScreenUpdating = False
dossier = "c:Program FilesMicrosoft Office 2000Office"
Lg = 1
Sheets.Add
Cells(Lg, 1) = "Fichiers dans " & dossier
Cells(Lg, 2) = "Taille"
Cells(Lg, 3) = "Date/Heure"
[A1:C1].Font.Bold = True
Lg = 2
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = dossier
.Filename = "*.*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
x = .FoundFiles(i)
Cells(Lg, 1) = Mid(x, Len(x) - Application.Find("",
StrReverse(x))

+ 2, 9 ^ 9)
Cells(Lg, 2) = FileLen(.FoundFiles(i))
Cells(Lg, 3) = FileDateTime(.FoundFiles(i))
Lg = Lg + 1
Next i
End With
[A:C].EntireColumn.AutoFit
End Sub

AV







Avatar
jps
merci alain et merci docm
ça rouuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuule
jps

"AV" a écrit dans le message de
news:
c'est quoi, alain, ce StrReverse qui bogue chez moi....parce qu'XL 97 je
pense...ça peut-y se remplacer?


Exact c'est une nouveauté XL 2000
La même chose pour XL97 et + :

Sub ListeFichiers() 'd'après J.W
Application.ScreenUpdating = False
dossier = "c:Program FilesMicrosoft Office 2000Office"
Lg = 1
Sheets.Add
Cells(Lg, 1) = "Fichiers dans " & dossier
Cells(Lg, 2) = "Taille"
Cells(Lg, 3) = "Date/Heure"
[A1:C1].Font.Bold = True
Lg = 2
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = dossier
.FileName = "*.*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
x = .FoundFiles(i)
y = ARABIC(x)
Cells(Lg, 1) = Mid(x, Len(x) - Application.Find("", y) + 2, 9
^ 9)

Cells(Lg, 2) = FileLen(.FoundFiles(i))
Cells(Lg, 3) = FileDateTime(.FoundFiles(i))
Lg = Lg + 1
Next i
End With
[A:C].EntireColumn.AutoFit
End Sub

Function ARABIC(zz) 'inverser la chaîne
For C = 0 To Len(zz)
ARABIC = ARABIC & Right(Left(zz, Len(zz) - C), 1)
Next
End Function

AV





Avatar
mye
merci de ta reponse, mais comme je suis un presque novice avec XL, alors je
n'ai rien compris. Existe-t-il un log tout fait ou un patch a mettre en
application de suite ?

--
m&y
"AV" a écrit dans le message de news:
OfRUg%
A adapter :

Sub ListeFichiers() 'd'après J.W
Application.ScreenUpdating = False
dossier = "c:Program FilesMicrosoft Office 2000Office"
Lg = 1
Sheets.Add
Cells(Lg, 1) = "Fichiers dans " & dossier
Cells(Lg, 2) = "Taille"
Cells(Lg, 3) = "Date/Heure"
[A1:C1].Font.Bold = True
Lg = 2
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = dossier
.Filename = "*.*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
x = .FoundFiles(i)
Cells(Lg, 1) = Mid(x, Len(x) - Application.Find("",
StrReverse(x))
+ 2, 9 ^ 9)
Cells(Lg, 2) = FileLen(.FoundFiles(i))
Cells(Lg, 3) = FileDateTime(.FoundFiles(i))
Lg = Lg + 1
Next i
End With
[A:C].EntireColumn.AutoFit
End Sub

AV




Avatar
mye
Bonjour, Alain et je te remercie de ta réponse.
J'ai potassé un peu VbA, et je m'en suis sorti : effectivement j'ai bien une
liste qui s'affiche dans un fichier XL, mais pas celui que je cherche.
Plus de precision : mon projet est de lister dans un fichier Excel, les
dossiers du repertoire C:Program files (uniquement les titres des
dossiers, sans taille ni date, puisque le but est de mettre dans la colonne
B de Excel, la fonction en francais, de chaque dossier)
J'avais avec WindowsMe, un logiciel (en anglais), "dir list" me semble-t-il,
qui ne fonctionne pas sous XP, il est vrai que l'impression ne se faisait
pas par XL, mais faute de grive....
merci de ta reponse

--
m&y
"mye" a écrit dans le message de news:

merci de ta reponse, mais comme je suis un presque novice avec XL, alors
je n'ai rien compris. Existe-t-il un log tout fait ou un patch a mettre en
application de suite ?

--
m&y
"AV" a écrit dans le message de news:
OfRUg%
A adapter :

Sub ListeFichiers() 'd'après J.W
Application.ScreenUpdating = False
dossier = "c:Program FilesMicrosoft Office 2000Office"
Lg = 1
Sheets.Add
Cells(Lg, 1) = "Fichiers dans " & dossier
Cells(Lg, 2) = "Taille"
Cells(Lg, 3) = "Date/Heure"
[A1:C1].Font.Bold = True
Lg = 2
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = dossier
.Filename = "*.*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
x = .FoundFiles(i)
Cells(Lg, 1) = Mid(x, Len(x) - Application.Find("",
StrReverse(x))
+ 2, 9 ^ 9)
Cells(Lg, 2) = FileLen(.FoundFiles(i))
Cells(Lg, 3) = FileDateTime(.FoundFiles(i))
Lg = Lg + 1
Next i
End With
[A:C].EntireColumn.AutoFit
End Sub

AV








Avatar
michdenis
Bonjour Mye,

essaie ceci :

'----------------------------------------
Sub ListerRépertoiresDunRépertoire()

Dim Fs As Object, T(), B As Integer
Dim Rep As String, Fichier As String
Dim F As Object, R As Object

Rep = "C:Program Files"

Set Fs = CreateObject("Scripting.FileSystemObject")

Set F = Fs.GetFolder(Rep)
For Each R In F.SubFolders
ReDim Preserve T(B + 1)
T(B) = R.Name
B = B + 1
Next
'Nom de la feuille et de la cellule à déterminer
With Worksheets("Feuil1")
.Range("B1").Resize(UBound(T) + 1) = Application.Transpose(T)
End With

Set Fs = Nothing: Set R = Nothing: Set F = Nothing

End Sub
'----------------------------------------


Salutations!



"mye" a écrit dans le message de news: ubLq$
Bonjour, Alain et je te remercie de ta réponse.
J'ai potassé un peu VbA, et je m'en suis sorti : effectivement j'ai bien une
liste qui s'affiche dans un fichier XL, mais pas celui que je cherche.
Plus de precision : mon projet est de lister dans un fichier Excel, les
dossiers du repertoire C:Program files (uniquement les titres des
dossiers, sans taille ni date, puisque le but est de mettre dans la colonne
B de Excel, la fonction en francais, de chaque dossier)
J'avais avec WindowsMe, un logiciel (en anglais), "dir list" me semble-t-il,
qui ne fonctionne pas sous XP, il est vrai que l'impression ne se faisait
pas par XL, mais faute de grive....
merci de ta reponse

--
m&y
"mye" a écrit dans le message de news:

merci de ta reponse, mais comme je suis un presque novice avec XL, alors
je n'ai rien compris. Existe-t-il un log tout fait ou un patch a mettre en
application de suite ?

--
m&y
"AV" a écrit dans le message de news:
OfRUg%
A adapter :

Sub ListeFichiers() 'd'après J.W
Application.ScreenUpdating = False
dossier = "c:Program FilesMicrosoft Office 2000Office"
Lg = 1
Sheets.Add
Cells(Lg, 1) = "Fichiers dans " & dossier
Cells(Lg, 2) = "Taille"
Cells(Lg, 3) = "Date/Heure"
[A1:C1].Font.Bold = True
Lg = 2
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = dossier
.Filename = "*.*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
x = .FoundFiles(i)
Cells(Lg, 1) = Mid(x, Len(x) - Application.Find("",
StrReverse(x))
+ 2, 9 ^ 9)
Cells(Lg, 2) = FileLen(.FoundFiles(i))
Cells(Lg, 3) = FileDateTime(.FoundFiles(i))
Lg = Lg + 1
Next i
End With
[A:C].EntireColumn.AutoFit
End Sub

AV