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 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
| Option Compare Database
Option Explicit
Private Type enregistrement
ordre As String * 10
espace1 As String * 1
indligne As String * 2
espace2 As String * 1
seance As String * 8
groupe As String * 2
code As String * 6
libelle As String * 18
mnemo As String * 5
ouverture As String * 12
cloture As String * 12
plushaut As String * 12
plusbas As String * 12
moyen As String * 12
qte As String * 9
nbtrans As String * 7
capitaux As String * 15
coursmeilleurd As String * 12
qtemeilleurd As String * 9
coursmeilleuro As String * 12
qtemeilleuro As String * 9
indres As String * 1
espace3 As String * 100
End Type
Private stopper
'Procédure de lecture de fichier en acces direct
Public Sub lireFichier(chemin As String)
On Error GoTo err
Dim Fichier As Integer, numenr As Long
Dim cours_2006 As enregistrement
Dim NbErreur As Long
stopper = False
'recupere un numero de fichier libre
Fichier = FreeFile
'Ouvre le fichier
Open chemin For Random As Fichier Len = Len(cours_2006)
numenr = 1
'parcours le fichier
While Not EOF(Fichier) And Not stopper
Get 1, numenr, cours_2006
'si l'enregistrement n'est pas vide
With cours_2006
If .ordre <> "" Then
'inserer dans la table
NbErreur = NbErreur + Insererdanstable(CLng(.ordre), CLng(.indligne), convertdate(.seance), CLng(.groupe), _
CLng(.code), .libelle, .mnemo, CLng(.ouverture), CLng(.cloture), CLng(.plushaut), CLng(.plusbas), CLng(.moyen), CLng(.qte), _
CLng(.nbtrans), CLng(.capitaux), CLng(.coursmeilleurd), CLng(.qtemeilleurd), CLng(.coursmeilleuro), CLng(.qtemeilleuro), .indres)
End If
End With
'augmente le numero de l'enregistrement à lire
numenr = numenr + 1
Wend
'Affiche le resume
MsgBox "Insertion terminée avec : " & _
NbErreur & " erreur(s)", vbInformation, _
"Insertion..."
GoTo fin
err:
'si erreur avertit l'utilisateur
MsgBox "Echec" & vbCrLf & vbCrLf & _
err.Description, vbCritical, "Insertion..."
fin:
'Ferme le fichier
Close Fichier
End Sub
Private Function Insererdanstable(Vordre As Long, Vindligne As Long, Vseance As Date, Vgroupe As Long, _
Vcode As Long, Vlibelle As String, Vmnemo As String, Vouverture As Long, Vcloture As Long, Vplushaut As Long, _
Vplusbas As Long, Vmoyen As Long, Vqte As Long, Vnbtrans As Long, Vcapitaux As Long, Vcoursmeilleurd As Long, _
Vqtemeilleurd As Long, Vcoursmeilleuro As Long, Vqtemeilleuro As Long, Vindres As String) As Long
On Error GoTo err
Dim SQL As String
'Créer la requête d'insertion
SQL = "INSERT INTO hist_cours (ordre,indligne,seance,groupe,code,libelle,mnemo,ouverture,cloture,plushaut,plusbas,moyen,qte,nbtrans,capitaux,coursmeilleurd,qtemeilleurd,coursmeilleuro,qtemeilleuro,indres) VALUES " & _
"(" & Vordre & "," & Vindligne & "," & Vseance & "," & Vgroupe & "," & Vcode & "," & Vlibelle & "," & Vlibelle & "," _
& Vouverture & "," & Vcloture & "," & Vplushaut & "," & Vplusbas & "," & Vmoyen & "," & Vqte & "," & Vnbtrans & "," _
& Vcapitaux & "," & Vcoursmeilleurd & "," & Vqtemeilleurd & "," & Vcoursmeilleuro & "," & Vqtemeilleuro & "," & Vindres & ")"
CurrentDb.Execute SQL
Exit Function
err:
Insererdanstable = 1
MsgBox "impossible d'insérer : " & vbcrl & _
VNumero & vbCrLf & _
VNom & vbCrLf & _
VPrenom & vbCrLf & vbCrLf & _
err.Description, vbCritical, "Insertion"
If MsgBox("voulez vous continuer ?", vbQuestion + vbYesNo, _
"Insertion") = vbNo Then stopper = True
End Function
'Private Function AjouterQuote(Chaine As String) As String
'enleve les caractère nuls
'Chaine = Replace(Chaine, Chr(0), "")
'Ajoute " de chaque coté de la chaine et
'double les guillemets à l'intérieur de
'la chaine et elimine les espaces
'AjouterQuote = Chr(34) & Trim$(Replace(Chaine, Chr(34), _
' Chr(34) & Chr(34))) & Chr(34)
'End Function
Private Function convertdate(seance As String) As Date
Dim nbr As Long
Dim anne As Long
Dim mois As Long
Dim jour As Long
nbr = CLng(seance)
anne = Int(nbr / 10000)
mois = Int((nbr Mod 10000) / 100)
jour = nbr Mod 1000000
convertdate = DateSerial(anne, mois, jour)
End Function |
Partager