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
|
Sub Fichier_TXT3()
Dim Rds As Recordset
Dim Ligne As String
Dim Chaine As String
Dim Caractere As String
Dim Nb_lig As Long
' Ouverture table Dico
Set Rds = CurrentDb.OpenRecordset("Select distinct nom_table, nom_fichier from DICO ")
Rds.MoveFirst
' Parcourt table Dico
Do While Not Rds.EOF
Nb_lig = 0
'S'il y a presence du fichier "csv" correspondant, alors
If (Rds!NOM_FICHIER = Dir(Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & Rds!NOM_FICHIER)) Then
' Ouverture des fichiers
Open Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & Rds!NOM_TABLE & ".txt" For Input Access Read As #1
Open Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\")) & Rds!NOM_TABLE & ".CSV" For Output Access Write As #2
Caractere = ""
' Parcourt de chaque ligne
Do While Not EOF(1)
Caractere = Input(1, #1)
If Caractere = "-" Then
Chaine = Caractere & Input(2, #1)
Select Case Chaine
Case "1-"
Ligne = Ligne & "01-"
Case "2-"
Ligne = Ligne & "02-"
Case "3-"
Ligne = Ligne & "03-"
Case "4-"
Ligne = Ligne & "04-"
Case "5-"
Ligne = Ligne & "05-"
Case "6-"
Ligne = Ligne & "06-"
Case "7-"
Ligne = Ligne & "07-"
Case "8-"
Ligne = Ligne & "08-"
Case "9-"
Ligne = Ligne & "09-"
Case Else
Ligne = Ligne & Chaine
End Select
Else
' Saut de ligne
If Caractere = vbCr Or Caractere = vbLf Then
If Len(Ligne) > 0 Then
Print #2, Ligne
Nb_lig = Nb_lig + 1
End If
Ligne = ""
Else
Ligne = Ligne & Caractere
End If
End If
Loop
' Fermeture des fichiers
Close #1
Close #2
End If
' Mise à jour du nombre de lignes du fichier
CurrentDb.Execute ("Update DICO set nb_lig_fic = " & Nb_lig & " where nom_table = """ & Rds!NOM_TABLE & """ ")
' Enregistrement suivant
Rds.MoveNext
Loop
Exit Sub
' Liberation
Rds.Close
Set Rds = Nothing
End Sub |
Partager