FICHIER À ACCÈS DIRECT

'*****************
'acces direct
'*****************

' déclaration en tout premier de la variable personnalisée
Type Enreg
     Val1 As String * 10 'vous devez toujours limité le nombre de caractères des chaînes
     Val2 As Integer
     Val3 As Date
End Type

Public Sub EcritDirect(UnEnreg As Enreg, strChemFich As String)
     Dim F As Integer, iNbEnreg As Integer

     F = FreeFile '1er numéro libre
'ce type de fichier s'ouvre toujours selon une certaine longueur d'enregistrement
     Open strChemFich For Random As #F Len = Len(UnEnreg)
     iNbEnreg = LOF(F) / Len(UnEnreg) 'on calcule le nombre d'enregistrement en divisant la longeur totale par la longueur d'un enregistrement
     Put #F, iNbEnreg + 1, UnEnreg 'on écrit l'enregistrement à la fin (nombre d'enregistrements +1)
     Close #F
End Sub

Public Function LitDirect(NoEnreg As Integer, strChemFich As String) As Enreg
     Dim F As Integer
     Dim UnEnreg As Enreg

     F = FreeFile '1er numéro libre
'ce type de fichier s'ouvre toujours selon une certaine longueur d'enregistrement
     Open strChemFich For Random As #F Len = Len(UnEnreg)
     Get #F, NoEnreg, UnEnreg 'vous écrivez la variable au n° d'enregistrement indiqué par NoEnreg
     Close #F
     LitDirect = UnEnreg
End Function

Public Sub EcritFichDirect()
     Dim TabEnreg(3) As Enreg
     Dim n As Byte

     For n = 0 To 3
     ' on remplit un tableau avec une boucle
          With TabEnreg(n) 'on attribue une donnée à chaque valeur
               .Val1 = "Nom" & n
               .Val2 = 25 * n
               .Val3 = Date + n
          End With
          'écriture dans le fichier
          EcritDirect TabEnreg(n), "C:\Documents and Settings\Cathy\Mes documents\Formation\Internet\Vba\direct.txt"
     Next
End Sub

Public Sub LitFichDirect()
     Dim MonEnreg As Enreg

' lecture dans le fichier
     MonEnreg = LitDirect(2, "C:\Documents and Settings\Cathy\Mes documents\Formation\Internet\Vba\direct.txt")
     MsgBox MonEnreg.Val1 & vbCrLf & MonEnreg.Val2 & vbCrLf & MonEnreg.Val3
End Sub