Private Sub tmrCreerListe_Timer()
Dim objFileSystem As FileSystemObject
Dim objFolder As Folder
Dim objFolders As Folders
Dim objFolderItem As Folder
Dim objFiles As Files
Dim objFile As File
Dim objTextStream As TextStream
Dim szFileName As String
Dim szTempFileName As String
Dim szFolderName As String
Dim vntSize As Variant
On Error GoTo ErrorHandler
' Faire seulement une fois
tmrCreerListe.Enabled = False
Set objFileSystem = CreateObject('Scripting.FileSystemObject')
szTempFileName = InputBox('Entrer nom de fichier', _
'Entrer chemin et nom de fichier:', _
'.txt')
If szTempFileName = '' Then
Exit Sub
Else
m_bAnnulerListe = False
Set objTextStream = objFileSystem.CreateTextFile(szTempFileName, True)
Set objFolder = objFileSystem.GetFolder(Dir1.Path)
Set objFolders = objFolder.SubFolders
Set objFiles = objFolder.Files
If Option1 Then
' Liste des sous-repertoires dans le repertoire
With objTextStream
Call .WriteLine('Repertoires dans ' & Dir1.Path & ' (MB)')
Call .WriteBlankLines(1)
For Each objFolderItem In objFolders
If m_bAnnulerListe Then
Exit For
End If
szFolderName = objFolderItem.Name
txtCourant = szFolderName
Call Refresh
vntSize = 0
vntSize = objFolderItem.Size
Call .WriteLine(szFolderName & vbTab & _
Format(CDbl(vntSize / 1024 ^ 2), '# ##0.0'))
DoEvents
Next
End With
Else
' Liste des fichiers dans le repertoire
With objTextStream
Call .WriteLine('Fichiers dans ' & Dir1.Path & ' (MB)')
Call .WriteBlankLines(1)
For Each objFile In objFiles
If m_bAnnulerListe Then
Exit For
End If
szFileName = objFile.Name
txtCourant = szFileName
Call Refresh
vntSize = 0
vntSize = objFile.Size
Call .WriteLine(szFileName & vbTab & _
Format(CDbl(vntSize / 1024 ^ 2), '# ##0.0'))
DoEvents
Next
End With
End If
If m_bAnnulerListe Then
MsgBox (szTempFileName & ' annulé!')
Else
MsgBox (szTempFileName & ' créé.')
End If
End If
Set objFileSystem = Nothing
Exit Sub