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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
Option Explicit
Private m_lngErrorNumber As Long
Private m_intFolders As Integer
Private m_lngFiles As Long
Sub TesterPourVoir()
Call ReadExcelFiles("C:\Documents and Settings\UserName\Mes documents\", "xls")
End Sub
Private Sub ReadExcelFiles(ByVal StartDir As String, Optional ByVal FileExtension As String = "xls")
Dim oFSO As Object
Dim straAllFiles() As String
Dim strErrorDescription As String
m_intFolders = 0
m_lngFiles = 0
On Error GoTo ReadExcelFiles_Error
Set oFSO = CreateObject("Scripting.FileSystemObject")
With oFSO
If Not .FolderExists(StartDir) Then
Err.Raise 75
Else
If ListAllFiles(StartDir, FileExtension, straAllFiles, oFSO, strErrorDescription) Then
MsgBox m_intFolders & " dossier(s) contenant des fiechier Excel" & vbCrLf & m_lngFiles & " fichier(s) trouvé(s)", vbInformation
Else
Err.Raise m_lngErrorNumber, "ReadExcelFiles()", strErrorDescription
End If
End If
End With
On Error GoTo 0
ReadExcelFiles_Exit:
Erase straAllFiles
Set oFSO = Nothing
Exit Sub
ReadExcelFiles_Error:
MsgBox Err.Description, vbExclamation, "Erreur " & Err.Number
Resume ReadExcelFiles_Exit
End Sub
Function ListAllFiles(ByVal FilePath As String, ByVal FileExtension As String, ByRef FileArray() As String, ByVal FSO As Object, ByRef ErrorDesc As String) As Boolean
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Dim blnNext As Boolean
Dim F As Long
Dim P As Integer
On Error GoTo ListAllFiles_Error
ListAllFiles = False
On Error Resume Next
Set oFolder = FSO.GetFolder(FilePath)
F = oFolder.Files.Count
If F <> 0 Then
For Each oFile In oFolder.Files
If StrComp(FSO.GetExtensionName(oFile.Name), FileExtension, 1) = 0 Then
P = P + 1
If P <= 1 Then
Debug.Print vbCrLf & oFolder.Path: Debug.Print String(Len(oFolder.Path), "-")
End If
m_lngFiles = m_lngFiles + 1
ReDim Preserve FileArray(UBound(FileArray) + 1)
FileArray(UBound(FileArray)) = oFile.Path
Debug.Print oFile.Name
'--------------------------------------
' => C'est là que tu lances ton traitement d'import Access
' Call ImportThisFileIntoDB(oFile.Path)
'--------------------------------------
End If
Next
End If
If oFolder.SubFolders.Count <> 0 Then
m_intFolders = m_intFolders + P
P = 0
For Each oSubFolder In oFolder.SubFolders
Call ListAllFiles(oSubFolder.Path, FileExtension, FileArray, FSO, ErrorDesc)
Next
End If
ListAllFiles = True
On Error GoTo 0
ListAllFiles_Exit:
Set oFolder = Nothing
Set oSubFolder = Nothing
Set oFile = Nothing
Exit Function
ListAllFiles_Error:
ListAllFiles = False
ErrorDesc = Err.Description
m_lngErrorNumber = Err.Number
Resume ListAllFiles_Exit
End Function |
Boucle pour importer et traiter des fichiers excel dans un dossier
Répondre avec citation
Envoyé par Tinien
Partager