Insérer des données dans un fichier
Contenu du snippet
Private Function InsertBytes(ByVal sFileName As String, ByRef baData() As Byte, ByVal lCursor As Long, Optional ByVal iPacketSize As Integer = 512) As Boolean 'sFileName -> chemin du fichier 'baData -> tableau à insérer, doit impérativement être dimensionné 'lCursor -> position d'insertion. on considère l'insertion "avant" le caractère, donc en tout début pour "1", AVANT le dernier caractère pour filelen 'iPacketSize -> taille du tampon à utiliser. pas de vérification, doit évidemment être positif 'retourne l'état de réussite Dim iNumFile As Integer 'numéro fichier Dim lFileLength As Long 'taille du fichier Dim baBuffer() As Byte 'tableau tampon Dim lBufferLength As Long 'taille du tampon courant Dim lPosStart As Long 'position début courante Dim lPosEnd As Long 'position début courante iNumFile = FreeFile On Local Error Resume Next Open sFileName For Binary Access Read Write As #iNumFile If Err.Number Then Err.Clear Else lFileLength = LOF(iNumFile) If (lCursor > lFileLength) Then lCursor = lFileLength + 1 ElseIf (lCursor <= 0) Then lCursor = 1 End If If lFileLength = 0 Then ' fichier vide, pratique Put #iNumFile, , baData Else ' agrandissement du fichier avec les data finales ; utilisées comme tampon lPosStart = lFileLength + 1 Seek #iNumFile, lPosStart Put #iNumFile, , baData ' dépassement fin de fichier = terminé If lCursor <= lFileLength Then ' décalage des données de la fin jusqu'au point d'insertion lPosEnd = lPosStart + UBound(baData) + LBound(baData) + 1 Do While Not lPosStart = lCursor lBufferLength = iPacketSize If lPosStart - lBufferLength < lCursor Then lBufferLength = lPosStart - lCursor lPosStart = lPosStart - lBufferLength lPosEnd = lPosEnd - lBufferLength ReDim baBuffer(0 To lBufferLength - 1) Seek #iNumFile, lPosStart Get #iNumFile, , baBuffer Seek #iNumFile, lPosEnd Put #iNumFile, , baBuffer Loop ' décalage OK, on peut insérer Seek #iNumFile, lCursor Put #iNumFile, , baData Erase baBuffer End If End If Close #iNumFile InsertBytes = True End If End Function Private Function InsertString(ByVal sFileName As String, ByRef sData As String, ByVal lCursor As Long) As Boolean If LenB(sData) > 0 Then InsertString = InsertBytes(sFileName, StrConv(sData, vbFromUnicode), lCursor) End Function
Compatibilité : VB6, VBA
A voir également
- Insérer des données dans un fichier
- Récupérer données json (javascript) - Conseils pratiques -Javascript
- Extraire des données d'un fichier excel avec python ✓ - Forum Python
- Lire classeur excel cellule par cellule ✓ - Forum Python
- Fichier .ini - Conseils pratiques -Visual Basic / VB.NET
- Inserer les données d'une table dans une autre sql - Forum SQL
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.