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 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
| Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
(ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
Option Explicit
Private Function CreationDossier(sDossier) As Long
Dim Rep As Long
Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function
Private Sub Lire(sDossier As String)
Dim sFichierIn As String, sFichierOut As String
Dim sChaine As String
Dim NumFichier1 As Integer, NumFichier2 As Integer
Dim sCheminIn As String, sCheminOut As String, sExt As String
Dim sDossierOut As String
Close
sDossierOut = ThisWorkbook.Path & "\" & "Filtrés"
CreationDossier sDossierOut
sFichierIn = Dir$(sDossier & "\*.*")
Do While Len(sFichierIn) > 0
sExt = Right$(sFichierIn, Len(sFichierIn) - InStrRev(sFichierIn, "."))
sFichierOut = sFichierIn
If UCase$(sExt) = "TXT" Then
sCheminIn = sDossier & "\" & sFichierIn
sCheminOut = sDossierOut & "\" & sFichierOut
NumFichier1 = FreeFile
Open sCheminIn For Input As #NumFichier1
NumFichier2 = FreeFile
Open sCheminOut For Output As #NumFichier2
Do While Not EOF(NumFichier1)
Line Input #NumFichier1, sChaine
If InStr(sChaine, "*******") = 0 Then
Print #NumFichier2, sChaine
End If
Loop
Close #NumFichier2
Close #NumFichier1
End If
sFichierIn = Dir$()
Loop
End Sub
Sub SelDossier()
Dim sChemin As String
sChemin = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = sChemin & "\"
.Title = "Sélectionner le Dossier Racine"
.AllowMultiSelect = False
.ButtonName = "Sélection Dossier"
.Show
If .SelectedItems.Count > 0 Then
DoEvents
Lire .SelectedItems(1)
End If
End With
End Sub |
Partager