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
|
Sub Tester()
ListZipContents Range("B2").Value
End Sub
Function ListZipContents(zipFilePath As Variant)
Dim oApp As Object, colFolders As New Collection, itm As Object, fld As Object
Dim isTxt As Integer, isfff As Integer, row As Integer
row = 2
Range("C2:C100000").Clear
Set oApp = CreateObject("Shell.Application")
colFolders.Add oApp.Namespace(zipFilePath).self
Do While colFolders.Count > 0
isTxt = 0
Set fld = colFolders(1) 'obtenir le premier dossier
colFolders.Remove 1 'et l'enlever de la collection...
For Each itm In oApp.Namespace(fld.Path).Items
If itm.isfolder Then
colFolders.Add itm 'sauvegarde le chemin du dossier pour listing
Else
isTxt = InStr(itm.Path, ".txt")
If isTxt > 0 Then
Debug.Print GetFirstLine(itm.Path)
If InStr(1, GetFirstLine(itm.Path), Range("A2").Value, vbTextCompare) > 0 Then
Range("C" & row + 1).Value = itm.Path
row = row + 1
End If
End If
Debug.Print itm.Path 'liste le chemin du fichier
End If
Next
Loop
End Function
Function GetFirstLine(MyFile As String) As String
If Dir(MyFile) <> "" Then
Open MyFile For Input As #1
Line Input #1, GetFirstLine
Close
End If
End Function |
Partager