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 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
|
Sub RecupFichiers()
Dim Tbl() As String
Dim Test As Integer
Dim I As Integer
'récupère les noms des fichiers se terminant par .xml en minuscules
'les extensions en majuscules sont ignorées
Tbl() = Fichiers("C:\Documents and Settings\Desktop\", ".xml")
'une erreur est générée si le tableau n'est pas initialisé
On Error Resume Next
Test = UBound(Tbl)
If Err.Number <> 0 Then
MsgBox "Aucun fichier dans le dossier !"
Err.Clear
Exit Sub
End If
'boucle sur le tableau
For I = 1 To UBound(Tbl)
'!!! Ici le traitement voulu...
'adapter :
'si le classeur doit être ouvert
'Workbooks.Open "C:\Documents and Settings\Desktop\" & Tbl
'enregistrer en .txt
'ActiveWorkbook.SaveAs "C:\Documents and Settings\Desktop\" & "B" & I & ".txt", xlUnicodeText
'etc...
' ThisWorkbook.XmlImport Tbl(I), Nothing, True, Worksheets("A1").Range("B1")
' Set XM = ThisWorkbook.XmlMaps(ThisWorkbook.XmlMaps.Count)
' MsgBox "Import terminé" & vbCrLf & _
' XM.RootElementName & vbCrLf & _
' XM.Name & vbCrLf & _
' XM.DataBinding.SourceUrl
Next I
End Sub
'Cette fonction retourne les noms des fichiers présents dans le dossier
'et ayant l'extension voulue dans un tableau String
Function Fichiers(Chemin As String, _
Extension As String) As String()
Dim Tbl() As String
Dim Fich As String
Dim I As Integer
Fich = Dir(Chemin)
Do While (Len(Fich) > 0)
'seuls les fichiers avec l'extension voulue
If InStr(Fich, Extension) <> 0 Then
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Fich
End If
Fich = Dir()
Loop
Fichiers = Tbl()
End Function |
Partager