1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
| Sub OpenFichiers()
'F. xxxxxxxx - Septembre 2006
Dim Dossier As Object, fichier As Object
Dim TabDossiers As Variant, Rep As Variant
Dim c As Range
Dim chemin As String
Dim L As Long, D As Long
'Application.DisplayAlerts = False 'Desactive les alertes de Excell
Rep = Application.InputBox("entrez le nom du répertoire à explorer", "Chemin du répertoire", _
"exemple", Type:=2)
If Rep = False Then Exit Sub
If Not Rep Like "*\?*" Then
MsgBox "Veuillez indiquer un dossier (pas un disque)!"
Exit Sub
End If
Application.ScreenUpdating = False
'Création du tableau des sous-dossiers existants
TabDossiers = lstDossiers_(Rep, True)
For D = 1 To UBound(TabDossiers)
'Chemin du dossier (ou sous-dossier) à analyser
chemin = TabDossiers(D) & "\"
'Analyse du dossier (ou sous-dossier)
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(chemin)
For Each fichier In Dossier.Files
'Liste les fichiers Excel
If fichier.Name Like "*.txt" Then
Rem Workbooks.Open Filename:=fichier
Workbooks.OpenText Filename:=fichier, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
' a mettre ici les actions a effectuer
Rem Serie_Arbeit
' jusqu'ici
L = L + 1
End If
Next
Next D
Set Dossier = Nothing
Application.ScreenUpdating = True
MsgBox "Traitement terminé !" & vbLf & L & " Fichier(s) modifié(s)"
'Application.DisplayAlerts = True 'Active les alertes de Excell
End Sub |
Partager