Supprimer dernière ligne fichier txt

Bonjour, afin de terminer un projet, j'aurais besoin d'insérer des lignes à la fin d'un fichier txt. Cependant, il faudrait que j'insère ces lignes au niveau de l'avant dernière ligne
</OBJECT>
<OBJECT CLASS="Connection" ID="JE_VIENS_DE_LE_RAJOUTER" MODULE="CODRA_Synopt"/>
</UNIT>
ici, entre <OBJECT CLASS> et </UNIT>
Voici le code que j'utilise actuellement :

cheminFichier = "D:\test_modif"

lignesAajouter = Array("Nouvelle ligne 1", "Nouvelle ligne 2", "Nouvelle ligne 3")

Fichier = FreeFile
Open cheminFichier For Append As Fichier

For i = LBound(lignesAajouter) To UBound(lignesAajouter)
    Print #Fichier, lignesAajouter(i)
Next i

Close Fichier

J'obtient ceci dans mon fichier txt :

</OBJECT>
<OBJECT CLASS="Connection" ID="JE_VIENS_DE_LE_RAJOUTER" MODULE="CODRA_Synopt"/>
</UNIT>"Nouvelle ligne 1"
"Nouvelle ligne 2"
"Nouvelle ligne 3"

Comment puis-je régler ce problème ?
Je pensais à supprimer la dernière ligne avant d'insérer mes lignes puis la remettre à la fin, mais il existe peut être une autre solution comme par exemple insérer les lignes directement au dessus de </UNIT>
Je ne peux pas créer de copie de ce fichier, cela prendrai trop de temps, le fichier peut être assez volumineux (plus de 200000 lignes)

Si d'autres personnes ont ce problème, j'ai fait ceci, en terme de vitesse, c'est ce que j'attendait, c'est suffisamment rapide (presque instantané)

    Dim fNum As Integer
    Dim nomFichier As String
    Dim lignes() As String
    Dim i As Long

    nomFichier = "D:\test_modif"

    fNum = FreeFile
    Open nomFichier For Input As fNum

    Do Until EOF(fNum)
        ReDim Preserve lignes(1 To i + 1)
        Line Input #fNum, lignes(i + 1)
        i = i + 1
    Loop

    Close fNum

    fNum = FreeFile
    Open nomFichier For Output As fNum

    For i = 1 To UBound(lignes) - 1
        Print #fNum, lignes(i)
    Next i

    Close fNum