' nécessite un bouton et une zone de texte
Option Explicit
'
Const FILE_SRC As String = "C:\Fichier1.txt"
Const FILE_DEST As String = "C:\Fichier2.txt"
'
'
Private Sub Form_Load()
Command1.Caption = "Transférer"
Text1.Text = "Cette phrase sera transférée si elle existe"
End Sub
'
'
Private Sub Command1_Click()
If LenB(Text1.Text) > 0 Then MsgBox "Réussite ? -> " & TransferString(Text1.Text)
End Sub
'
'
Private Function TransferString(ByVal sChaine As String) As Boolean
' init
TransferString = False
' source existe?!
If Dir(FILE_SRC) <> vbNullString Then
Dim FFs%, FFd%
' on récupère le fichier source
FFs = FreeFile
Open FILE_SRC For Input As #FFs
Dim sSource As String, lPos As Long
sSource = Input(LOF(FFs), 1)
Close #FFs
' position chaine à trouver
lPos = InStr(1, sSource, sChaine)
' zero = pas trouvée
If lPos > 0 Then
' on ajoute la ligne au fichier de destination
FFd = FreeFile
Open FILE_DEST For Append As #FFd
Print #FFd, sChaine
Close #FFd
' on supprime la ligne du fichier source
Dim sBegin As String, sEnd As String
sBegin = Left$(sSource, lPos - 1)
sEnd = Right$(sSource, Len(sSource) - Len(sChaine) - lPos + 1)
FFs = FreeFile
Open FILE_SRC For Output As #FFs
Print #FFs, sBegin
Print #FFs, sEnd
Close #FFs
' vide var
sBegin = vbNullString
sEnd = vbNullString
sChaine = vbNullString
' retour
TransferString = True
End If
End If
End Function