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 45 46
| Sub ouverture_fichierx()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim RepFich As Variant
Dim CL1 As Workbook, z As Integer, Rep$
Dim FL1 As Worksheet
Set CL1 = ThisWorkbook
'Répertoire des fichiers à copier
Rep = "D:\romain\travail\Sophy_2004_origine\essai\Classeurs\"
'Crée le tableau des fichiers du répertoire
Set RepFich = Application.FileSearch
'Ouverture des fichiers du répertoire
With RepFich
.LookIn = Rep
.FileType = msoFileTypeAllFiles
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For z = 1 To .FoundFiles.Count
DoEvents
Macro_corresp_nom_espece CL1, .FoundFiles(z)
Next
Else
MsgBox "Aucun fichier dans le répertoire " & Rep
End If
End With
End Sub
Sub Macro_corresp_nom_espece(CL1 As ThisWorkbook, Fichier)
'
' Macro1 Macro
' Macro enregistrée le 29/04/2008 par Utilisateur
'
Dim CL2 As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Open "D:\romain\travail\extraction_sophy\essai2.txt" For Append As #1 'Crée un fichier par ajout
Set CL2 = Workbooks.Open(Fichier)
... suite de mon script |
Partager