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
|
Public Sub Importer(strNomFichier As String)
Dim FSO As New Scripting.FileSystemObject
Dim Fichier As Scripting.TextStream
Dim strLigne As String
Dim strNomMarqueur As String
Dim strNomGene As String
Dim strNomSeqF As String
Dim strNomSeqR As String
'Seqtype définit si ce sont des Snp ou des singletons ou tout autre type
Dim strNomSeqType As String
'Les deux suivants définissent la position en cartographie physique et génétique
Dim strValCPhy As String
Dim strValCGen As String
Set Fichier = FSO.OpenTextFile(strNomFichier, ForReading)
Dim Rst As DAO.Recordset
Dim I As Integer
'Charge la table en mémoire
Set Rst = CurrentDb.OpenRecordset("TableTest2", dbOpenTable)
'Charge mon fichier
Fichier = "D:\Mes Documents\Soria\Annexe1.txt"
'Tant que non fin de fichier
While Not Fichier.AtEndOfStream
'lit la ligne
strLigne = Fichier.ReadLine
'Si elle n''est pas fini
If Trim(strLigne) <> "Fin" Then
'Si c'est une ligne d'initiation
If Left(strLigne, 15) = "Nom du marqueur" Then
'Si on est sur un nouvel enregistrement, on le valide
If Rst.EditMode = dbEditAdd Then Rst.Update
Else
'Sinon, si on est pas en mode ajout, on ajoute un nouvel enregistrement
If Not Rst.EditMode = dbEditAdd Then
Rst.AddNew
'Fixe le numéro
Rst.Fields("Numero") = Rst.RecordCount + 1
End If
'Récupère la position des
I = InStr(1, strLigne, "marqueurs", vbTextCompare)
If I > 0 Then
'Récupère le nom du champ et la valeur
strNomMarqueur = Trim(Mid(strLigne, I + 3))
strNomGene = Trim(Mid(strLigne, I + 3))
strNomSeqF = Trim(Mid(strLigne, I + 3))
strNomSeqR = Trim(Mid(strLigne, I + 3))
strNomSeqType = Trim(Mid(strLigne, I + 3))
strNomValCPhy = Trim(Mid(strLigne, I + 3))
strNomValCGen = Trim(Mid(strLigne, I + 3, 15))
'Remplit la table
Rst.Fields(strNomChamp).Value = strValeur
End If
End If
End If
Wend
'Ferme tout
Fichier.Close
Rst.Close
Set Rst = Nothing
Set Fichier = Nothing
Set FSO = Nothing
End Sub |
Partager