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
| Option Compare Database
Private Const MY_TABLE As String = "info1"
Private Function ImportMyFile(ByRef NBRows As Long) As Boolean
Const MY_FOLDER As String = "C:\aa\"
Const MY_FILES_START_WITH As String = "info"
Const MY_DB As String = "C:\aa\id_import.mdb"
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.Folder
Dim oFile As Scripting.File
Dim strStartWith As String
    On Error GoTo ErrorHandler
    
    Set oFSO = New FileSystemObject
    Set oFld = oFSO.GetFolder(MY_FOLDER)
    For Each oFile In oFld.Files
        'Looking for "info"
        strStartWith = Mid(oFile.Name, InStrRev(oFile.Name, "\") + 1, 4)
        If strStartWith = MY_FILES_START_WITH Then
          Call ImportThisFileToDB(MY_FOLDER & oFile.Name, MY_TABLE, MY_DB)
          NBRows = NBRows + 1
        End If
    Next
    Set oFld = Nothing
    Set oFile = Nothing
    Set oFSO = Nothing
    
    ImportMyFile = True
    Exit Function
    
ErrorHandler:
    ImportMyFile = False
    Exit Function
End Function
Private Sub ImportThisFileToDB(ByVal FileToImport As String, _
ByVal TableName As String, ByVal DBName As String)
  DoCmd.TransferText acImportDelim, "ScriptImportInfo1", TableName, _
FileToImport, False
End Sub
Private Sub cmdImport_Click()
Dim lngNBRecords As Long
If ImportMyFile(lngNBRecords) Then
  MsgBox "Importation terminé !" & vbCrLf & vbCrLf & _
  Str(lngNBRecords) & " fichier(s) traité(s) avec succès", 48
  DoCmd.OpenTable MY_TABLE, acViewNormal, acReadOnly
Else
  MsgBox "Importation échouée !", 48
End If
End Sub |
automatisation importation fichierS txt
Répondre avec citation
Envoyé par jeanchcom
Partager